Tenemos un archivo de entrenamiento para realizar un aprendizaje supervisado formado por 1460 casos con 81 variables.
Una de ellas es nuestro objetivo SalePrice, y debemos ser capaces de predecir esa variable con el dataframe Test que se nos proporciona, que es de 1459 casos.
Otra variable importante es la primera Id que nos identifica de manera única cada registro.
En el dataframe Train tenemos los 1460 primeros.
En el dataframe Test tenemos desde el 1461 hasta el 2919
Tenemos varios tipos de variables, como se vera en el siguiente epígrafe, además de las cuales cambiaremos los tipos de algunas.
Hay que realizar una limpieza y control exhaustiva de todos los datos, haciendo énfasis en los valores NA
Para realizar una preparación adecuada y buscar un modelo hay que unir los dos dataframe creando los datos que nos faltan en Test (SalePrice la variable objetivo ) y poniendo como valor NA
Sumario, estructura de los dataset y dimensiones
Id MSSubClass MSZoning LotFrontage
Min. : 1.0 Min. : 20.0 Length:1460 Min. : 21.00
1st Qu.: 365.8 1st Qu.: 20.0 Class :character 1st Qu.: 59.00
Median : 730.5 Median : 50.0 Mode :character Median : 69.00
Mean : 730.5 Mean : 56.9 Mean : 70.05
3rd Qu.:1095.2 3rd Qu.: 70.0 3rd Qu.: 80.00
Max. :1460.0 Max. :190.0 Max. :313.00
NA's :259
LotArea Street Alley LotShape
Min. : 1300 Length:1460 Length:1460 Length:1460
1st Qu.: 7554 Class :character Class :character Class :character
Median : 9478 Mode :character Mode :character Mode :character
Mean : 10517
3rd Qu.: 11602
Max. :215245
LandContour Utilities LotConfig
Length:1460 Length:1460 Length:1460
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
LandSlope Neighborhood Condition1
Length:1460 Length:1460 Length:1460
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
Condition2 BldgType HouseStyle OverallQual
Length:1460 Length:1460 Length:1460 Min. : 1.000
Class :character Class :character Class :character 1st Qu.: 5.000
Mode :character Mode :character Mode :character Median : 6.000
Mean : 6.099
3rd Qu.: 7.000
Max. :10.000
OverallCond YearBuilt YearRemodAdd RoofStyle
Min. :1.000 Min. :1872 Min. :1950 Length:1460
1st Qu.:5.000 1st Qu.:1954 1st Qu.:1967 Class :character
Median :5.000 Median :1973 Median :1994 Mode :character
Mean :5.575 Mean :1971 Mean :1985
3rd Qu.:6.000 3rd Qu.:2000 3rd Qu.:2004
Max. :9.000 Max. :2010 Max. :2010
RoofMatl Exterior1st Exterior2nd
Length:1460 Length:1460 Length:1460
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
MasVnrType MasVnrArea ExterQual ExterCond
Length:1460 Min. : 0.0 Length:1460 Length:1460
Class :character 1st Qu.: 0.0 Class :character Class :character
Mode :character Median : 0.0 Mode :character Mode :character
Mean : 103.7
3rd Qu.: 166.0
Max. :1600.0
NA's :8
Foundation BsmtQual BsmtCond
Length:1460 Length:1460 Length:1460
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
BsmtExposure BsmtFinType1 BsmtFinSF1 BsmtFinType2
Length:1460 Length:1460 Min. : 0.0 Length:1460
Class :character Class :character 1st Qu.: 0.0 Class :character
Mode :character Mode :character Median : 383.5 Mode :character
Mean : 443.6
3rd Qu.: 712.2
Max. :5644.0
BsmtFinSF2 BsmtUnfSF TotalBsmtSF Heating
Min. : 0.00 Min. : 0.0 Min. : 0.0 Length:1460
1st Qu.: 0.00 1st Qu.: 223.0 1st Qu.: 795.8 Class :character
Median : 0.00 Median : 477.5 Median : 991.5 Mode :character
Mean : 46.55 Mean : 567.2 Mean :1057.4
3rd Qu.: 0.00 3rd Qu.: 808.0 3rd Qu.:1298.2
Max. :1474.00 Max. :2336.0 Max. :6110.0
HeatingQC CentralAir Electrical X1stFlrSF
Length:1460 Length:1460 Length:1460 Min. : 334
Class :character Class :character Class :character 1st Qu.: 882
Mode :character Mode :character Mode :character Median :1087
Mean :1163
3rd Qu.:1391
Max. :4692
X2ndFlrSF LowQualFinSF GrLivArea BsmtFullBath
Min. : 0 Min. : 0.000 Min. : 334 Min. :0.0000
1st Qu.: 0 1st Qu.: 0.000 1st Qu.:1130 1st Qu.:0.0000
Median : 0 Median : 0.000 Median :1464 Median :0.0000
Mean : 347 Mean : 5.845 Mean :1515 Mean :0.4253
3rd Qu.: 728 3rd Qu.: 0.000 3rd Qu.:1777 3rd Qu.:1.0000
Max. :2065 Max. :572.000 Max. :5642 Max. :3.0000
BsmtHalfBath FullBath HalfBath BedroomAbvGr
Min. :0.00000 Min. :0.000 Min. :0.0000 Min. :0.000
1st Qu.:0.00000 1st Qu.:1.000 1st Qu.:0.0000 1st Qu.:2.000
Median :0.00000 Median :2.000 Median :0.0000 Median :3.000
Mean :0.05753 Mean :1.565 Mean :0.3829 Mean :2.866
3rd Qu.:0.00000 3rd Qu.:2.000 3rd Qu.:1.0000 3rd Qu.:3.000
Max. :2.00000 Max. :3.000 Max. :2.0000 Max. :8.000
KitchenAbvGr KitchenQual TotRmsAbvGrd Functional
Min. :0.000 Length:1460 Min. : 2.000 Length:1460
1st Qu.:1.000 Class :character 1st Qu.: 5.000 Class :character
Median :1.000 Mode :character Median : 6.000 Mode :character
Mean :1.047 Mean : 6.518
3rd Qu.:1.000 3rd Qu.: 7.000
Max. :3.000 Max. :14.000
Fireplaces FireplaceQu GarageType GarageYrBlt
Min. :0.000 Length:1460 Length:1460 Min. :1900
1st Qu.:0.000 Class :character Class :character 1st Qu.:1961
Median :1.000 Mode :character Mode :character Median :1980
Mean :0.613 Mean :1979
3rd Qu.:1.000 3rd Qu.:2002
Max. :3.000 Max. :2010
NA's :81
GarageFinish GarageCars GarageArea GarageQual
Length:1460 Min. :0.000 Min. : 0.0 Length:1460
Class :character 1st Qu.:1.000 1st Qu.: 334.5 Class :character
Mode :character Median :2.000 Median : 480.0 Mode :character
Mean :1.767 Mean : 473.0
3rd Qu.:2.000 3rd Qu.: 576.0
Max. :4.000 Max. :1418.0
GarageCond PavedDrive WoodDeckSF OpenPorchSF
Length:1460 Length:1460 Min. : 0.00 Min. : 0.00
Class :character Class :character 1st Qu.: 0.00 1st Qu.: 0.00
Mode :character Mode :character Median : 0.00 Median : 25.00
Mean : 94.24 Mean : 46.66
3rd Qu.:168.00 3rd Qu.: 68.00
Max. :857.00 Max. :547.00
EnclosedPorch X3SsnPorch ScreenPorch PoolArea
Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 0.000
1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.: 0.00 1st Qu.: 0.000
Median : 0.00 Median : 0.00 Median : 0.00 Median : 0.000
Mean : 21.95 Mean : 3.41 Mean : 15.06 Mean : 2.759
3rd Qu.: 0.00 3rd Qu.: 0.00 3rd Qu.: 0.00 3rd Qu.: 0.000
Max. :552.00 Max. :508.00 Max. :480.00 Max. :738.000
PoolQC Fence MiscFeature
Length:1460 Length:1460 Length:1460
Class :character Class :character Class :character
Mode :character Mode :character Mode :character
MiscVal MoSold YrSold SaleType
Min. : 0.00 Min. : 1.000 Min. :2006 Length:1460
1st Qu.: 0.00 1st Qu.: 5.000 1st Qu.:2007 Class :character
Median : 0.00 Median : 6.000 Median :2008 Mode :character
Mean : 43.49 Mean : 6.322 Mean :2008
3rd Qu.: 0.00 3rd Qu.: 8.000 3rd Qu.:2009
Max. :15500.00 Max. :12.000 Max. :2010
SaleCondition SalePrice
Length:1460 Min. : 34900
Class :character 1st Qu.:129975
Mode :character Median :163000
Mean :180921
3rd Qu.:214000
Max. :755000
'data.frame': 1460 obs. of 81 variables:
$ Id : int 1 2 3 4 5 6 7 8 9 10 ...
$ MSSubClass : int 60 20 60 70 60 50 20 60 50 190 ...
$ MSZoning : chr "RL" "RL" "RL" "RL" ...
$ LotFrontage : int 65 80 68 60 84 85 75 NA 51 50 ...
$ LotArea : int 8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
$ Street : chr "Pave" "Pave" "Pave" "Pave" ...
$ Alley : chr NA NA NA NA ...
$ LotShape : chr "Reg" "Reg" "IR1" "IR1" ...
$ LandContour : chr "Lvl" "Lvl" "Lvl" "Lvl" ...
$ Utilities : chr "AllPub" "AllPub" "AllPub" "AllPub" ...
$ LotConfig : chr "Inside" "FR2" "Inside" "Corner" ...
$ LandSlope : chr "Gtl" "Gtl" "Gtl" "Gtl" ...
$ Neighborhood : chr "CollgCr" "Veenker" "CollgCr" "Crawfor" ...
$ Condition1 : chr "Norm" "Feedr" "Norm" "Norm" ...
$ Condition2 : chr "Norm" "Norm" "Norm" "Norm" ...
$ BldgType : chr "1Fam" "1Fam" "1Fam" "1Fam" ...
$ HouseStyle : chr "2Story" "1Story" "2Story" "2Story" ...
$ OverallQual : int 7 6 7 7 8 5 8 7 7 5 ...
$ OverallCond : int 5 8 5 5 5 5 5 6 5 6 ...
$ YearBuilt : int 2003 1976 2001 1915 2000 1993 2004 1973 1931 1939 ...
$ YearRemodAdd : int 2003 1976 2002 1970 2000 1995 2005 1973 1950 1950 ...
$ RoofStyle : chr "Gable" "Gable" "Gable" "Gable" ...
$ RoofMatl : chr "CompShg" "CompShg" "CompShg" "CompShg" ...
$ Exterior1st : chr "VinylSd" "MetalSd" "VinylSd" "Wd Sdng" ...
$ Exterior2nd : chr "VinylSd" "MetalSd" "VinylSd" "Wd Shng" ...
$ MasVnrType : chr "BrkFace" "None" "BrkFace" "None" ...
$ MasVnrArea : int 196 0 162 0 350 0 186 240 0 0 ...
$ ExterQual : chr "Gd" "TA" "Gd" "TA" ...
$ ExterCond : chr "TA" "TA" "TA" "TA" ...
$ Foundation : chr "PConc" "CBlock" "PConc" "BrkTil" ...
$ BsmtQual : chr "Gd" "Gd" "Gd" "TA" ...
$ BsmtCond : chr "TA" "TA" "TA" "Gd" ...
$ BsmtExposure : chr "No" "Gd" "Mn" "No" ...
$ BsmtFinType1 : chr "GLQ" "ALQ" "GLQ" "ALQ" ...
$ BsmtFinSF1 : int 706 978 486 216 655 732 1369 859 0 851 ...
$ BsmtFinType2 : chr "Unf" "Unf" "Unf" "Unf" ...
$ BsmtFinSF2 : int 0 0 0 0 0 0 0 32 0 0 ...
$ BsmtUnfSF : int 150 284 434 540 490 64 317 216 952 140 ...
$ TotalBsmtSF : int 856 1262 920 756 1145 796 1686 1107 952 991 ...
$ Heating : chr "GasA" "GasA" "GasA" "GasA" ...
$ HeatingQC : chr "Ex" "Ex" "Ex" "Gd" ...
$ CentralAir : chr "Y" "Y" "Y" "Y" ...
$ Electrical : chr "SBrkr" "SBrkr" "SBrkr" "SBrkr" ...
$ X1stFlrSF : int 856 1262 920 961 1145 796 1694 1107 1022 1077 ...
$ X2ndFlrSF : int 854 0 866 756 1053 566 0 983 752 0 ...
$ LowQualFinSF : int 0 0 0 0 0 0 0 0 0 0 ...
$ GrLivArea : int 1710 1262 1786 1717 2198 1362 1694 2090 1774 1077 ...
$ BsmtFullBath : int 1 0 1 1 1 1 1 1 0 1 ...
$ BsmtHalfBath : int 0 1 0 0 0 0 0 0 0 0 ...
$ FullBath : int 2 2 2 1 2 1 2 2 2 1 ...
$ HalfBath : int 1 0 1 0 1 1 0 1 0 0 ...
$ BedroomAbvGr : int 3 3 3 3 4 1 3 3 2 2 ...
$ KitchenAbvGr : int 1 1 1 1 1 1 1 1 2 2 ...
$ KitchenQual : chr "Gd" "TA" "Gd" "Gd" ...
$ TotRmsAbvGrd : int 8 6 6 7 9 5 7 7 8 5 ...
$ Functional : chr "Typ" "Typ" "Typ" "Typ" ...
$ Fireplaces : int 0 1 1 1 1 0 1 2 2 2 ...
$ FireplaceQu : chr NA "TA" "TA" "Gd" ...
$ GarageType : chr "Attchd" "Attchd" "Attchd" "Detchd" ...
$ GarageYrBlt : int 2003 1976 2001 1998 2000 1993 2004 1973 1931 1939 ...
$ GarageFinish : chr "RFn" "RFn" "RFn" "Unf" ...
$ GarageCars : int 2 2 2 3 3 2 2 2 2 1 ...
$ GarageArea : int 548 460 608 642 836 480 636 484 468 205 ...
$ GarageQual : chr "TA" "TA" "TA" "TA" ...
$ GarageCond : chr "TA" "TA" "TA" "TA" ...
$ PavedDrive : chr "Y" "Y" "Y" "Y" ...
$ WoodDeckSF : int 0 298 0 0 192 40 255 235 90 0 ...
$ OpenPorchSF : int 61 0 42 35 84 30 57 204 0 4 ...
$ EnclosedPorch: int 0 0 0 272 0 0 0 228 205 0 ...
$ X3SsnPorch : int 0 0 0 0 0 320 0 0 0 0 ...
$ ScreenPorch : int 0 0 0 0 0 0 0 0 0 0 ...
$ PoolArea : int 0 0 0 0 0 0 0 0 0 0 ...
$ PoolQC : chr NA NA NA NA ...
$ Fence : chr NA NA NA NA ...
$ MiscFeature : chr NA NA NA NA ...
$ MiscVal : int 0 0 0 0 0 700 0 350 0 0 ...
$ MoSold : int 2 5 9 2 12 10 8 11 4 1 ...
$ YrSold : int 2008 2007 2008 2006 2008 2009 2007 2009 2008 2008 ...
$ SaleType : chr "WD" "WD" "WD" "WD" ...
$ SaleCondition: chr "Normal" "Normal" "Normal" "Abnorml" ...
$ SalePrice : int 208500 181500 223500 140000 250000 143000 307000 200000 129900 118000 ...
[1] 1460 81
Variables cuantificables. Variables categoricas . Variables cuantificadas
| Codigo | Significado |
|---|---|
| ID | Identidad |
| LotFrontage | pies lineales de la calle conectados a la propiedad |
| LotArea | Tamaño del lote en pies cuadrados |
| YearBuilt | fecha de construcción original |
| YearRemodAdd | fecha de remodelación |
| MasVnrArea | área de chapa de la albañilería en pies cuadrados |
| BsmtFinSF1 | Tipo 1 pies cuadrados terminados |
| BsmtFinSF2 | Tipo 2 pies cuadrados terminados |
| BsmtUnfSF | Pies cuadrados sin terminar del área del sótano |
| TotalBsmtSF | pies cuadrados totales del área del sótano |
| 1stFlrSF | primer piso pies cuadrados |
| 2ndFlrSF | segundo piso pies cuadrados |
| LowQualFinSF | Pies cuadrados terminados de baja calidad (todos los pisos) |
| GrLivArea | pies cuadrados del área habitable sobre el nivel del suelo |
| BsmtFullBath | baños completos en el sótano |
| BsmtHalfBath | medio baño en el sótano |
| FullBath | baños completos por encima del grado |
| HalfBath | medio baño por encima del grado |
| Codigo | Significado |
|---|---|
| Bedroom | Número de habitaciones sobre el nivel del sótano |
| Kitchen | Número de cocinas |
| TotRmsAbvGrd | Total de habitaciones por encima del grado (no incluye baños) |
| Fireplaces | cantidad de chimeneas |
| GarageYrBlt | año de garaje fue construido |
| GarageCars | tamaño del garaje en la capacidad del automóvil |
| GarageArea | Tamaño del garaje en pies cuadrados |
| WoodDeckSF | área de cubierta de madera en pies cuadrados |
| OpenPorchSF | área de porche abierto en pies cuadrados |
| EnclosedPorch | área de porche cerrado en pies cuadrados |
| 3SsnPorch | área del porche de tres estaciones en pies cuadrados |
| ScreenPorch | área del porche de la pantalla en pies cuadrados |
| PoolArea | área de la piscina en pies cuadrados |
| MiscVal | $ Valor de la función miscelánea |
| MoSold | Mes vendido |
| YrSold | Año de venta |
| SalePrice | el precio de venta de la propiedad en dólares. |
Veamos primero cuantos valores y en cuantas columnas tenemos NA
| x | |
|---|---|
| PoolQC | 2909 |
| MiscFeature | 2814 |
| Alley | 2721 |
| Fence | 2348 |
| SalePrice | 1459 |
| FireplaceQu | 1420 |
| LotFrontage | 486 |
| GarageYrBlt | 159 |
| GarageFinish | 159 |
| GarageQual | 159 |
| GarageCond | 159 |
| GarageType | 157 |
| BsmtCond | 82 |
| BsmtExposure | 82 |
| BsmtQual | 81 |
| BsmtFinType2 | 80 |
| BsmtFinType1 | 79 |
| MasVnrType | 24 |
| MasVnrArea | 23 |
| MSZoning | 4 |
| Utilities | 2 |
| BsmtFullBath | 2 |
| BsmtHalfBath | 2 |
| Functional | 2 |
| Exterior1st | 1 |
| Exterior2nd | 1 |
| BsmtFinSF1 | 1 |
| BsmtFinSF2 | 1 |
| BsmtUnfSF | 1 |
| TotalBsmtSF | 1 |
| Electrical | 1 |
| KitchenQual | 1 |
| GarageCars | 1 |
| GarageArea | 1 |
| SaleType | 1 |
Veamos un listado de los valores NA usados como categoria
Estaban marcados en rojo en su respectiva tabla
Alleytipo de acceso a callejones
Codigo Significado NA No alley access
BsmtQualAltura del sótano
Codigo Significado NA No Basement
BsmtCondestado general del sótano
Codigo Significado NA No Basement
BsmtExposuremuros de sotano a ras de suelo o de jardín
Codigo Significado NA No Basement
BsmtFinType1Calidad del área acabada del sótano
Codigo Significado NA No Basement
BsmtFinType2Calidad del segundo área terminada (si está presente)
Codigo Significado NA No Basement
FireplaceQucalidad de la chimenea
Codigo Significado NA No Fireplace
GarageTypeubicación del garaje
Codigo Significado NA No Garage
GarageFinishacabado interior del garaje
Codigo Significado NA No Garage
GarageQualcalidad de garaje
Codigo Significado NA No Garage
GarageCondcondición de garaje
Codigo Significado NA No Garage
PoolQCcalidad de la piscina
Codigo Significado NA No Pool
Fencecalidad de la cerca
Codigo Significado NA No Fence
MiscFeaturecaracterística miscelánea no cubierta en otras categorías
Codigo Significado NA None
Podemos apreciar que en todas las variables donde aparece (Callejon, Sotanos, Garages, Piscinas, Cerca y Varios), el sentido que se le da es “Ninguno” o “No existe”.
Por lo que podemos cambiar el código en esas variables por NONE
Volvemos a comprobar cuantas columnas quedan con valores NA despues de la sustitucion
| x | |
|---|---|
| SalePrice | 1459 |
| LotFrontage | 486 |
| GarageYrBlt | 159 |
| MasVnrType | 24 |
| MasVnrArea | 23 |
| MSZoning | 4 |
| Utilities | 2 |
| BsmtFullBath | 2 |
| BsmtHalfBath | 2 |
| Functional | 2 |
| Exterior1st | 1 |
| Exterior2nd | 1 |
| BsmtFinSF1 | 1 |
| BsmtFinSF2 | 1 |
| BsmtUnfSF | 1 |
| TotalBsmtSF | 1 |
| Electrical | 1 |
| KitchenQual | 1 |
| GarageCars | 1 |
| GarageArea | 1 |
| SaleType | 1 |
NOS QUEDAN VALORES NULOS POR CONCRETAR EN:
GarageYrBlt --> 159 registros GarageCars --> 1 registros GarageArea --> 1 registros
SOTANO(BASEMENT)
BsmtFullBath --> 2 registros BsmtHalfBath --> 2 registros BsmtFinSF1 --> 1 registro BsmtFinSF2 --> 1 registro BsmtUnfSF --> 1 registro TotalBsmtSF --> 1 registro
MAMPOSTERIA (MasVnr)
MasVnrType --> 24 registros MaVnrArea --> 23 registros
PROPIEDAD (Lot)
LotFrontage --> 486 registros
EXTERIOR
Exterior1st --> 1 registro Exterior2nd --> 1 registro
Utilities --> 2 registros
FUNCIONAL (Functional)
Functional --> 2 registros
ELECTRICO (Electrical)
Electrical --> 1 registro
COCINA (Kitchen)
KitchenQual --> 1 registro
VENTA (Sale)
SaleType --> 1 registro
ZONIFICACION
MSZoning --> 4 registro
Vamos a buscar contradicciones entre características similares
No se puede establecer una relacion directa entre la calidad de la piscina y el area.
Buscaremos en la calidad general de la casa
| Id | PoolQC | PoolArea |
|---|---|---|
| 2421 | NONE | 368 |
| 2504 | NONE | 444 |
| 2600 | NONE | 561 |
Tenemos tres registros que tienen un area de piscina sin tenerla
| Var1 | Freq |
|---|---|
| NONE | 2909 |
| Ex | 4 |
| Gd | 4 |
| Fa | 2 |
| Id | PoolQC | PoolArea | OverallQual | OverallCond |
|---|---|---|---|---|
| 198 | Ex | 512 | 8 | 4 |
| 811 | Fa | 648 | 6 | 6 |
| 1171 | Gd | 576 | 6 | 6 |
| 1183 | Ex | 555 | 10 | 5 |
| 1299 | Gd | 480 | 10 | 5 |
| 1387 | Fa | 519 | 7 | 5 |
| 1424 | Gd | 738 | 6 | 7 |
| 1975 | Ex | 144 | 10 | 5 |
| 2421 | NONE | 368 | 4 | 6 |
| 2504 | NONE | 444 | 6 | 5 |
| 2574 | Ex | 228 | 8 | 5 |
| 2600 | NONE | 561 | 3 | 5 |
| 2711 | Gd | 800 | 7 | 4 |
razon a la proporcion OverallQual*100/PoolArea
| Id | PoolQC | PoolArea | OverallQual | OverallCond | razon |
|---|---|---|---|---|---|
| 1975 | Ex | 144 | 10 | 5 | 6.944 |
| 2574 | Ex | 228 | 8 | 5 | 3.509 |
| 1299 | Gd | 480 | 10 | 5 | 2.083 |
| 1183 | Ex | 555 | 10 | 5 | 1.802 |
| 198 | Ex | 512 | 8 | 4 | 1.562 |
| 2504 | NONE | 444 | 6 | 5 | 1.351 |
| 1387 | Fa | 519 | 7 | 5 | 1.349 |
| 2421 | NONE | 368 | 4 | 6 | 1.087 |
| 1171 | Gd | 576 | 6 | 6 | 1.042 |
| 811 | Fa | 648 | 6 | 6 | 0.926 |
| 2711 | Gd | 800 | 7 | 4 | 0.875 |
| 1424 | Gd | 738 | 6 | 7 | 0.813 |
| 2600 | NONE | 561 | 3 | 5 | 0.535 |
Si se puede establecer una cierta relación , por lo que asignamos la calidad de la piscina asi, teniendo en cuenta que good Gd es mejor que fair Fa
total[2504,73]<-'Gd'
total[2421,73]<-'Gd'
total[2600,73]<-'Fa'
No existe contradiccion entre el numero de chimeneas y la calidad
nrow(total%>%filter(Fireplaces>0 & FireplaceQu=='NONE')%>%select(Id,Fireplaces,FireplaceQu,OverallQual,OverallCond))[1] 0
En las areas tenemos que el area del tipo 1 + area del tipo 2 + area sin terminar = Area total
Comprobamos y buscamos incongruencias
prueba<-total%>%select(Id,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
prueba[,2]<--prueba[,2]
prueba[,6]<-apply(prueba[,2:5],1,sum)
nrow(prueba%>%filter(V6>0))[1] 0
No existe ningun registro con el area mal
En los registros sin sotano compruebo que no exista algún campo que no corresponda
Existen 79 registros que no tienen sotano
prueba<-total%>%filter(BsmtQual=='NONE'|BsmtCond=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
prueba1<-prueba%>%filter(BsmtQual!='NONE'|BsmtCond!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'|BsmtFullBath>0|BsmtHalfBath>0)%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
nrow(prueba1)[1] 0
Ninguno de ellos tiene incongruencias
Busco los sotanos existentes que no tienen area construida en el primer tipo
prueba<-total%>%filter(BsmtFinType1!='NONE' & BsmtFinSF1==0 )%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
table(prueba$BsmtFinType1,prueba$BsmtFinType2)
Unf
Unf 851
Esos 851 no tiene tampoco del segundo tipo Unf
table(prueba$BsmtFinSF1,prueba$BsmtFinSF2)
0
0 851
Las areas son 0 en todos los casos
nrow(prueba%>%filter(prueba$BsmtUnfSF==0))[1] 0
Todos los registros aparecen como Unf Inacabado. Es correcto
En los inmuebles sin garaje buscamos registros que tengan campos con contradicciones o incongruencias
prueba<-total%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE')%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))[1] 0
En los inmuebles con garaje buscamos registros que tengan campos con contradicciones o incongruencias
prueba<-total%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE' | GarageYrBlt==0 | GarageCars==0 | GarageArea==0)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))[1] 0
Teniendo en cuenta que para el análisis con las variable independientes categóricas se crearan variables “dummy”, tantas como categorías-1 por cada variable, parece claro pensar que favorece reducir el numero de variables, reduciendo la complejidad.
En nuestro caso , y en mi opinión es posible realizarlo cambiando ciertas variables de categóricas a ordinales. Sobre todo en aquellas que tengan un orden que parezca lógico.
Para seguir un criterio razonable, he escogido la transformación creciente desde 0 hasta el numero de categorías dentro de cada variable, siempre desde menos a mas, o si se prefiere de peor a mejor, pero con la salvedad de que 0 solo se escoge para la categoría que significa que no existe esa variable.
Por simplificar con un ejemplo, puedo tener una variable que me habla de la calidad del acabado del garaje, dentro de las cuales tengo varias categorías que van desde una mala calidad a una muy buena. Evidentemente el orden es creciente con el máximo valor para la mejor de las categorías, pero el 0 se reserva solo si dentro de esas categorías me aparece una indicando que no tiene garaje
Estas son las variables categóricas que he seleccionado, y al lado la asignación que le doy a cada categoría de cada una de ellas
Vamos a revisar las variables que ya teníamos como ordinales en los datos originales
Mientras que OverallQual y OverallCond no ofrecen ninguna duda, MSSubclass me parece que no esta correctamente planteada.
Puede que se usara ese código numerico para identificar mejor las distintas clases de edificación pero no tiene una relación ordinal
Se puede apreciar en el grafico con la relación que tiene con el precio
En el caso de variables cuantitativas originalmente en el dataset , vamos a revisar aquellas que no tengan justificación como numericas
Antes de empezar voy a revisar la normalidad de las variables cuantitativas para lo cual he creado un pequeño codigo que me indica la normalidad SI o NO de las variables
NO
38
El resultado es que ninguna de las variables numéricas tienen normalidad. Esto me sirve para seleccionar el método de correlacion de Spearman
Vemos las variables cuantitativas susceptibles de cambiarse a categoricas
En principio voy a revisar aquellas cuya cantidad represente algo en si misma, y en esta categoría entran todo lo referido a fechas. Repasando una por una
En la categoria de fechas se encuentran las 4 primeras
YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)
GarageYrBuilt (Año en el que fue construido el garage)
Veremos a continuacion el resto de variables cuantitativas y relación entre ellas para poder ver si reducimos su numero.
Voy a crear una matriz de correlaciones entre estas variables sin contar en principio con el precio.
Para saber si existe una dependencia entre algunas de ellas que nos pueda servir.
Para eso uso el paquete corrplot
Esta es la revision general
REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)
Vere a continuación las variables con una fuerte correlacion por si se puede reducir el numero de variables predictoras
GRLIVAREA FULLBATH TOTRMSABVGRD
Normalizacion de resto de variables
Todos estos epigrafes se encuentran ademas en el menu 2 PREPARACION
En el caso del estudio de las variables categóricas, tenemos que partir de un enfoque diferente
Como estamos hablando de variables categóricas no podemos en principio calcular un valor directo como usábamos el de la correlacion en las variables continuas.
Pero si podemos usar el coeficiente de determinación o bondad del ajuste que en los casos de regresion lineal simple es el cuadrado de la correlacion de Pearson.
Luego la forma de seleccionar aquellas variables que tienen influencia sobre el precio va a ser calcular el coeficiente de determinación
Para facilitar esto vamos a usar el paquete FactoMineR.
Esta todo detallado en el menu 3 PREPARACION
En azul el total de viviendas, y por encima en rojo solo el conjunto de entrenamiento.
No parece que haya excesivas diferencias y en la mayoría de los meses se aprecia visualmente que el conjunto de entrenamiento representa la mitad del total.
Podemos apreciar que la numeración se refiere evidentemente a los meses y refleja una distribución en la venta superior en los meses de Mayo, Junio y Julio.
El precio medio es parecido y no se ve relación con el mes (por encima aparece la cantidad)
cor(x=TrainNum$MoSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")[1] 0.0694322
En mi opinión con esa correlacion tan próxima a 0 no influye para nada en el precio
cor(x=TrainNum$YrSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")[1] -0.0298991
Tienen una correlacion cercana a 0 lo cual indica una influencia en el precio infima
Tiene la particularidad de que nos puede servir para considerar la antigüedad de la vivienda y ahí puede ser relevante su uso.
Voy a posponerlo para mas adelante cuando veamos el año de construcción y el de remodelación
Vemos estas dos variables puesto que están muy relacionadas.
El año de construccion no necesita explicación, en cuanto a el año de remodelacion es el año en que la vivienda ha sufrido algún tipo de reforma.
Si no ha tenido ninguna esta se corresponde con la fecha de construcción.
Tiene la peculiaridad de que computa a partir de 1950, y en ese año tiene un numero extraordinario de casos, 178 en el Train y 361 en el total, seguramente porque se empezaría a computar ese año y todas las que tienen una antigüedad mayor se computan aqui
#Correlacion año construccion
cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")[1] 0.652682
#Correlacion año remodelacion
cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")[1] 0.571159
¿Que pasaria si distinguimos aquellas casas que han sido remodeladas , y por lo tanto su fecha de remodelacion es diferente a la de construccion, de aquellas que no lo han sido?
#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")[1] 0.643186
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")[1] 0.478056
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")[1] 0.680097
Esta claro que importa el año de construccion, importa el año de remodelacion, importa si estan o no remodeladas en cuanto afecta a su antigüedad y además tenemos unos valores extraños en 1950 que debemos corregir.
Voy a considerar que ninguna de esas viviendas situadas en 1950 han sido remodeladas por lo que aplicare a esa variable, la del año de construcción
#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")[1] 0.613344
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")[1] 0.229517
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")[1] 0.708576
Vamos a afinar un poco mas calculando la antigüedad respecto al año de venta. Creamos una columna nueva
| Id | YearBuilt | YrSold |
|---|---|---|
| 2550 | 2008 | 2007 |
total[2550,78]<-2008Existe un registro con el año de venta anterior al de la construccion. Lo igualo
Buscarè errores también en el año de remodelación
| Id | YrSold | YearBuilt | YearRemodAdd |
|---|---|---|---|
| 524 | 2007 | 2007 | 2008 |
| 2296 | 2007 | 2007 | 2008 |
| 2550 | 2008 | 2008 | 2009 |
total[524,21]<-2007
total[2296,21]<-2007
total[2550,21]<-2008Corrijo los valores del año de remodelacion posteriores al año de construccion y venta, y pongo los valores de este ultimo
| Id | YrSold | YearBuilt | YearRemodAdd |
|---|---|---|---|
| 1877 | 2009 | 2002 | 2001 |
total[1877,21]<-2002El año de remodelacion es anterior al de construccion
Corrijo los valores al año de construccion
#Calculamos correlacion para remodelados
cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")[1] -0.612723
#No remodelados
cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")[1] -0.706995
Al cambiar el calculo sobre la antiguedad se invierte el signo de la correlacion
Los valores son parecidos pero al calcular sobre el numero de años se invierte el signo
En conclusión, la antigüedad de la vivienda tiene una relación fuerte con el precio de venta, y además el hecho de ser una vivienda remodelada o no tambien es importante.
Le afecta menos cuando se ha realizado dicha remodelación.
#Conclusiones
total$Remodelado<-0
total$Remodelado[total$YearBuilt!=total$YearRemodAdd]<-1
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]Si calculamos la correlacion de la antiguedad respecto al precio tenemos un valor -0.65012.
Hemos visto que los remodelados tienen -0.612723 y los no remodelados -0.706995 lo que significa que están penalizados por el calculo conjunto.
Podriamos pensar que si tomamos la antigüedad como la diferencia entre el año de venta y el de remodelación(teniendo en cuenta que para las viviendas no remodeladas este es igual que el de construcción) obtendríamos una variable mas adecuada, pero es al contrario , el valor de la correlacion es -0.575787.
Hay que encontrar una manera de penalizar a las viviendas remodeladas en su antigüedad
Mi propuesta es penalizar a las viviendas que han sido remodeladas aumentando su antigüedad de manera artificial.
Proporcionalmente al tiempo que se ha tardado en remodelar. ¿Cuánto?. La decima porcentual que tienen de diferencia las correlaciones.
#Penalizacion
TotalNum.remo<-TotalNum%>%filter(Remodelado==1)
summary(TotalNum.remo$YearRemodAdd-TotalNum.remo$YearBuilt) Min. 1st Qu. Median Mean 3rd Qu. Max.
1.0 1.0 20.0 29.9 52.0 127.0
total$Penaliza<-total$YearRemodAdd-total$YearBuilt
#Normalizo y penalizo
total$Antiguedad<-normalize(total$Antiguedad)
total$Penaliza<-normalize(total$Penaliza)
total$Antiguedad<-total$Antiguedad+total$Penaliza*0.1
#Borro las variables auxiliares Remodelado y Penaliza
total$Remodelado<-NULL
total$Penaliza<-NULL
#Vemos correlacion nueva variable Antiguedad
cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")[1] -0.65012
Creo una columna donde pongo este calculo
Como la antiguedad la tenemos en enteros y para ser justo con la penalizacion voy a normalizar las variables
Luego le aplicare un 10% de la antigüedad de la remodelación a la antigüedad de la vivienda
La correlacion de Antiguedad es de -0.641654
Partiamos de una correlacion de Año Construccion de 0.652682 y en Año Remodelacion de 0.570737
Nos hemos acercado a la mas alta pero reduciendo a la mitad el numero de variables
Tenemos un outlier. Corresponde al registro 2593.
| Id | GarageType | GarageYrBlt | GarageFinish | GarageQual | GarageArea | GarageCond | GarageCars | YearBuilt | YearRemodAdd | YrSold |
|---|---|---|---|---|---|---|---|---|---|---|
| 2593 | Attchd | 2207 | 2 | 3 | 502 | 3 | 2 | 2006 | 2007 | 2007 |
total[2593,60]<-2007Podemos inferir que el año real de construcción del garaje es 2007 y no 2207.
| Id | YearBuilt | GarageYrBlt |
|---|---|---|
| 30 | 1927 | 1920 |
| 94 | 1910 | 1900 |
| 325 | 1967 | 1961 |
| 601 | 2005 | 2003 |
| 737 | 1950 | 1949 |
| 1104 | 1959 | 1954 |
| 1377 | 1930 | 1925 |
| 1415 | 1923 | 1922 |
| 1419 | 1963 | 1962 |
| 1522 | 1959 | 1956 |
| 1577 | 2010 | 2009 |
| 1806 | 1935 | 1920 |
| 1841 | 1978 | 1960 |
| 1896 | 1941 | 1940 |
| 1898 | 1935 | 1926 |
| 2123 | 1945 | 1925 |
| 2264 | 2006 | 2005 |
| 2510 | 2006 | 2005 |
total$GarageYrBlt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]<-total$YearBuilt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)Hay 18 registros que tienen el año de construccion del garage anterior al de la vivienda. Entiendo que se debe a errores tipográficos, como confundir un 4 por un 9 o diferencias pequeñas de tiempo que hacen variar en un año
Podemos pensar que parece existir una relación.
cor(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice,method="spearman",use="na.or.complete")[1] 0.594246
Hay que tener en cuenta que no he incluido los registros que no tienen garaje.
Si se les incluye, curiosamente la correlacion aumenta.
#Calculo antiguedad Garaje
total$AntGarage<-total$YrSold-total$GarageYrBlt
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Correlacion
cor(x=TrainNum$AntGarage,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")[1] -0.63301
Todo el grupo de observaciones que se ve a la derecha son aquellos que no tienen garage y les sale como antiguedad tanta como el año de venta. Eso les supone una penalizacion
En conclusion para las variables YearBuilt, YearRemodAdd, MoSold, YrSold y GarageYrBlt nos quedamos con Antigüedad y AntGarage como variables importantes para el precio de venta
Se ve claramente dependencia en ciertos grupos de variables.
En el grafico en la fila inferior tenemos SalePrice.
En rojo las variables con correlacion negativa :
AntGarage Antigüedad
En azul las variables predictoras con correlacion positiva:
GarageArea GarageCars
Fireplaces FireplaceQu
X1stFlrSF TotalBsmtSF
TotRmsAbvGrd GrLivArea FullBath
GarageFinish
KitchenQual
BsmtQual
ExterQual
OverallQual
Las variables que pongo juntas tienen una correlacion fuerte (ver primer grafico ) entre ellas y cierta explicacion lógica.
Es evidente que tiene una gran correlacion porque en cierta medida su valor crece de manera proporcionada.
Si una vivienda tiene un garaje, la antigüedad del garaje crece de igual manera que la antigüedad de la vivienda y suelen ser iguales salvo que el garaje se haya construido después.
De todas formas no soy partidario de unirlas de alguna forma porque la variable AntGarage tiene la peculiaridad de aquellas viviendas sin garaje que hay que mantener
Solo voy a normalizar la varable AntGarage, puesto que Antigüedad ya lo estaba
total$AntGarage<-normalize(total$AntGarage)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
A pesar de que tienen relación con otras variables la mas importante es entre ellos, y puede parecer lógico puesto que el numero de coches que pueda entrar en un garaje depende directamente del espacio que este tenga
TotalNum$GarageArea<-normalize(TotalNum$GarageArea)
TotalNum$GarageCars<-normalize(TotalNum$GarageCars)
cor(x=TotalNum$GarageArea,y=TotalNum$GarageCars,method = 'spearman')[1] 0.864929
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
cor(x=TrainNum$GarageArea,y=TrainNum$SalePrice,method = 'spearman')[1] 0.649379
cor(x=TrainNum$GarageCars,y=TrainNum$SalePrice,method = 'spearman')[1] 0.690711
La opcion que opto es multiplicar ambas variables puesto que GarageCars es discreta y GarageArea es continua.
GARAGETOTAL se convierte en continua, mantiene la normalización y el valor 0 para los que no tienen garaje
TrainNum$Garage2<-TrainNum$GarageArea*TrainNum$GarageCars
cor(x=TrainNum$Garage2,y=TrainNum$SalePrice,method = 'spearman')[1] 0.668591
Es una correlacion media de las otras dos.
Normalizo y actualizo
total$GarageTotal<-normalize(total$GarageArea)*normalize(total$GarageCars)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
Fireplaces es el numero de chimeneas
FireplacesQu es la calidad según vimos cuando se paso de categorica a ordinal
La correlacion positiva entre ellas nos indica que a medida que el numero de chimeneas aumenta también aumenta la calidad
cor(x=total$Fireplaces,y=total$FireplaceQu,method = 'kendall')[1] 0.820617
Con respecto al precio
cor(x=TrainNum$FireplaceQu,y=TrainNum$SalePrice,method='spearman')[1] 0.537602
cor(x=TrainNum$Fireplaces,y=TrainNum$SalePrice,method='spearman')[1] 0.519247
La correlacion con el precio no es muy alta y ademas la correlacion entre ellas es altisima, por lo que me quedo con una y descarto la otra
Me quedo con FireplaceQu. Y la normalizo
total$FireplaceQu<-normalize(total$FireplaceQu)Ademas es una relacion fuerte. Vemos un grafico
cor(x=total$X1stFlrSF,y=total$TotalBsmtSF,method='spearman')[1] 0.828737
summary(total$X1stFlrSF) Min. 1st Qu. Median Mean 3rd Qu. Max.
334 876 1082 1160 1388 5095
summary(total$TotalBsmtSF) Min. 1st Qu. Median Mean 3rd Qu. Max.
0 793 989 1051 1302 6110
1stFlrSF corresponde al área del primer piso.
TotalBsmtSF es el área del sotano
Se presupone que las viviendas que tienen sotano , por lo general el área en planta del sotano es igual que el de la primera planta.
La diferencia por lo general esta en que todas las viviendas tienen primera planta, pero no todas tienen sotano
Se aprecian dos líneas claramente, una siguiendo el eje de abscisas en o que son las viviendas sin sotano y la otra línea de inclinación 45º que son las viviendas que tienen el mismo área de vivienda que de sotano.
Hay que destacar que hay unas cuantas viviendas que tienen mas área de sotano que de primer piso
cor(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice,method='spearman')[1] 0.575408
cor(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice,method='spearman')[1] 0.602725
No parece que haya una correlacion muy alta .
| Id | X1stFlrSF | TotalBsmtSF | SalePrice |
|---|---|---|---|
| 524 | 3138 | 3138 | 184750 |
| 1299 | 4692 | 6110 | 160000 |
TrainNum.piso<-TrainNum%>%filter(Id!=524)%>%filter(Id!=1299)cor(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice,method='spearman')[1] 0.576221
cor(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice,method='spearman')[1] 0.603604
#Separo las viviendas por el sotano
TrainNum.sot<-TrainNum%>%filter(TotalBsmtSF==0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)
TrainNum.piso<-TrainNum%>%filter(TotalBsmtSF>0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)Sí hay mejoria pero no parece significativa.
En principio no descarto estos registros por si afectan a otras variables
Voy a separar en la variable de área de primera planta a las viviendas que tienen sotano y las que no
Se aprecia que las vivendas sin sotano (puntos rojos) por lo general están penalizadas en el precio, casi todas están en la parte baja de la nube.
En mi opinión se debería combinar ambas variables pero que penalizen a las viviendas sin sotano, parecido a lo que sucedia a la penalizacion en la antigüedad.
Para eso voy a sumar el área del sotano y el de la primera planta
La mayoría de las viviendas verán casi doblada su superficie, pero las viviendas sin sotano se quedan como están
[1] 0.623865
total$AreaPiso<-normalize(total$X1stFlrSF+total$TotalBsmtSF)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)La correlacion mejora
La distribución parece bastante parecida.
Dejamos asi la nueva variable y la normalizamos
| GrLivArea | FullBath | TotRmsAbvGrd | |
|---|---|---|---|
| GrLivArea | 1.000000 | 0.662752 | 0.808775 |
| FullBath | 0.662752 | 1.000000 | 0.536076 |
| TotRmsAbvGrd | 0.808775 | 0.536076 | 1.000000 |
Estas variables corresponde a
GrLivArea pies cuadrados del área habitable sobre el nivel del suelo
FullBath baños completos por encima del suelo
TotRmsAbvGrd Total de habitaciones por encima del suelo (no incluye baños)
Parece evidente una relación lógica entre la primera variable y las otras dos
En rojo el numero de baños y en azul el total de estancias por encima del nivel del suelo.
Todo en funcion del precio de venta de la casa
| Id | GrLivArea | FullBath | TotRmsAbvGrd |
|---|---|---|---|
| 1299 | 5642 | 2 | 12 |
| 2550 | 5095 | 2 | 15 |
[1] "Correlacion sin outliers"
| GrLivArea | FullBath | TotRmsAbvGrd | |
|---|---|---|---|
| GrLivArea | 1.000000 | 0.662584 | 0.808373 |
| FullBath | 0.662584 | 1.000000 | 0.535749 |
| TotRmsAbvGrd | 0.808373 | 0.535749 | 1.000000 |
[1] "Correlacion con outliers"
| GrLivArea | FullBath | TotRmsAbvGrd | |
|---|---|---|---|
| GrLivArea | 1.000000 | 0.662752 | 0.808775 |
| FullBath | 0.662752 | 1.000000 | 0.536076 |
| TotRmsAbvGrd | 0.808775 | 0.536076 | 1.000000 |
Les descarto y compruebo como queda la matriz de correlacion
Parece que incluso ha empeorado con respecto al anterior (se muestra mas abajo)
[1] "Correlacion con outliers"
| GrLivArea | FullBath | TotRmsAbvGrd | SalePrice | |
|---|---|---|---|---|
| GrLivArea | 1.000000 | 0.658419 | 0.827874 | 0.731310 |
| FullBath | 0.658419 | 1.000000 | 0.558665 | 0.635957 |
| TotRmsAbvGrd | 0.827874 | 0.558665 | 1.000000 | 0.532586 |
| SalePrice | 0.731310 | 0.635957 | 0.532586 | 1.000000 |
[1] "Correlacion sin outliers"
| GrLivArea | FullBath | TotRmsAbvGrd | SalePrice | |
|---|---|---|---|---|
| GrLivArea | 1.000000 | 0.658246 | 0.827514 | 0.732112 |
| FullBath | 0.658246 | 1.000000 | 0.558364 | 0.636043 |
| TotRmsAbvGrd | 0.827514 | 0.558364 | 1.000000 | 0.533215 |
| SalePrice | 0.732112 | 0.636043 | 0.533215 | 1.000000 |
Se puede observar como al quitar los outliers la correlacion entre las variables que estudiamos empeoran pero mejoran todas con respecto al precio.
Lo dejamos en recordatorio como los otros outliers que hemos visto para más adelante
| Id | HalfBath | BsmtFullBath | BsmtHalfBath |
|---|---|---|---|
| 54 | 1 | 2 | 0 |
| 189 | 2 | 2 | 0 |
| 376 | 1 | 1 | 0 |
| 598 | 2 | 0 | 2 |
| 635 | 0 | 2 | 0 |
| 917 | 0 | 1 | 0 |
| 1164 | 2 | 2 | 0 |
| 1214 | 0 | 1 | 1 |
| 1271 | 1 | 2 | 0 |
| 1860 | 2 | 2 | 0 |
| 2514 | 1 | 2 | 0 |
| 2601 | 1 | 2 | 0 |
Pregunta: ¿Qué significa que haya viviendas que no tengan baño?
Respuesta: Que tienen medios baños o baños en el sotano
En la tabla las casas que no tienen baño
Las vivendas sin baño están penalizadas en el precio aunque no demasiado
estancia mas#Sumamos los baños
TotalNum$estancias<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd| GrLivArea | FullBath | TotRmsAbvGrd | estancias | |
|---|---|---|---|---|
| GrLivArea | 1.000000 | 0.662752 | 0.808775 | 0.852309 |
| FullBath | 0.662752 | 1.000000 | 0.536076 | 0.743707 |
| TotRmsAbvGrd | 0.808775 | 0.536076 | 1.000000 | 0.960388 |
| estancias | 0.852309 | 0.743707 | 0.960388 | 1.000000 |
Evidentemente la correlacion con las variables que la componen tiene que ser alta, pero con el area habitable mejora bastante la correlacion individual mejor que tenia antes
La correlacion de GrLivArea con FullBath es 0.662752 y con TotRmsAbvGrd es 0.808775
Con la nueva variable estancias es 0.852309
#Sumamos los medios baños
TotalNum$estancias2<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd+(TotalNum$HalfBath/2)| GrLivArea | FullBath | TotRmsAbvGrd | estancias | estancias2 | |
|---|---|---|---|---|---|
| GrLivArea | 1.000000 | 0.662752 | 0.808775 | 0.852309 | 0.865065 |
| FullBath | 0.662752 | 1.000000 | 0.536076 | 0.743707 | 0.723524 |
| TotRmsAbvGrd | 0.808775 | 0.536076 | 1.000000 | 0.960388 | 0.958442 |
| estancias | 0.852309 | 0.743707 | 0.960388 | 1.000000 | 0.991040 |
| estancias2 | 0.865065 | 0.723524 | 0.958442 | 0.991040 | 1.000000 |
Aunque empeora la correlacion con las otras variables, mejora con el area habitable que es con la que voy a combinarla y normalizarlas
#Combinar con area habitable y normalizar
TotalNum$Habitat<-normalize(TotalNum$estancias2*TotalNum$GrLivArea)
#Comparamos con precio
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)| GrLivArea | FullBath | TotRmsAbvGrd | estancias | Habitat | SalePrice | |
|---|---|---|---|---|---|---|
| GrLivArea | 1.000000 | 0.658419 | 0.827874 | 0.860974 | 0.974100 | 0.731310 |
| FullBath | 0.658419 | 1.000000 | 0.558665 | 0.751499 | 0.714628 | 0.635957 |
| TotRmsAbvGrd | 0.827874 | 0.558665 | 1.000000 | 0.964700 | 0.916140 | 0.532586 |
| estancias | 0.860974 | 0.751499 | 0.964700 | 1.000000 | 0.948747 | 0.618233 |
| Habitat | 0.974100 | 0.714628 | 0.916140 | 0.948747 | 1.000000 | 0.704260 |
| SalePrice | 0.731310 | 0.635957 | 0.532586 | 0.618233 | 0.704260 | 1.000000 |
#Crear variable y normalizar
total$Habitat<-normalize((total$FullBath+total$TotRmsAbvGrd+(total$HalfBath/2))*total$GrLivArea)Como el numero de estancias es cuasidiscreto (por tener medios baños) y el area habitable es continuo multiplico ambos para obtener una nueva variable Habitat continua
La nueva variable esta mucho mas correlacionada con las tres variables originales y además se acerca bastante a la variable original de mayor correlacion con el precio
Creamos en dataset conjunto y normalizamos
GarageFinish acabado interior del garaje
KitchenQual calidad de la cocina
BsmtQual Altura del sótano
ExterQual calidad del material exterior
OverallQual material general y calidad de acabado
Son todas variables ordinales que indican distintos acabados/calidades de la vivienda
Es razonable pensar que junto con otras variables que no aparecen por no estar tan relacionadas, mantengan una correspondencia al nivel general de calidad de la vivienda y este está asociado al precio de manera importante.
En mi opinión no tiene justificación lógica el combinar varias de estas variables puesto que no tienen una relación causal a pesar de que tengan una correlacion importante
Las normalizamos
total$GarageFinish<-normalize(total$GarageFinish)
total$KitchenQual<-normalize(total$KitchenQual)
total$BsmtQual<-normalize(total$BsmtQual)
total$ExterQual<-normalize(total$ExterQual)
total$OverallQual<-normalize(total$OverallQual)
De todas las variables cuantitativas nos quedamos con las siguientes:
Antiguedad AntGaraje GarageTotal FirePlaceQu AreaPiso Habitat GarageFinish KitchenQual BsmtQual ExterQual OverallQual
De un total de 51 variables numéricas del dataset (excluyendo la identificación Id y el precio de venta SalePrice) hemos reducido las variables predictoras a 11
FactoMineR tiene varias opciones interesantes para realizar distintas métodos de analisis de datos y entre ellos tiene un método llamado condes() que sirve para describir una variable continua en función de variables continuas y/o categóricas #Buscamos categorias mas proximas a SalePrice
options(digits=12)
fact1<-condes(TrainFact,num.var = 30)
Esto nos genera una lista de tres elementos (como maximo)
Una matriz con las variables cualitativas ordenadas por R²
Una matriz con las variables cuantitativas ordenadas por correlacion
Una matriz con los coeficientes de cada categoría de las variables cualitativas que cumplen con el p-value asignado
Nuestro interés esta en la primera matriz.
Teniendo en cuenta que para la selección de las variables cuantitativas significativas poníamos como criterio que la correlacion debía ser superior a 0.5, entonces en este caso R² > (0.5)²=0.25 .
Ese es el limite que ponemos
Estas son las variables
#Estas son las variables
fact1.cuali<-as.data.frame(fact1[[1]])| R2 | p.value | |
|---|---|---|
| Neighborhood | 0.545574990810 | 0.000000000000 |
| Foundation | 0.256368401530 | 0.000000000000 |
| GarageType | 0.249204230504 | 0.000000000000 |
| MSSubClass | 0.246315972818 | 0.000000000000 |
| MasVnrType | 0.180235182646 | 0.000000000000 |
| SaleCondition | 0.135497476871 | 0.000000000000 |
| Exterior1st | 0.152773123142 | 0.000000000000 |
| Exterior2nd | 0.153829860125 | 0.000000000000 |
| SaleType | 0.137287486979 | 0.000000000000 |
| MSZoning | 0.107559683446 | 0.000000000000 |
| HouseStyle | 0.086312627304 | 0.000000000000 |
| CentralAir | 0.063165845939 | 0.000000000000 |
| Electrical | 0.059650931845 | 0.000000000000 |
| PavedDrive | 0.054539728331 | 0.000000000000 |
| RoofStyle | 0.057696630128 | 0.000000000000 |
| Fence | 0.035614716819 | 0.000000000094 |
| BldgType | 0.034534026889 | 0.000000000206 |
| LandContour | 0.025794085461 | 0.000000027422 |
| RoofMatl | 0.031413123044 | 0.000000072314 |
| Condition1 | 0.032630639960 | 0.000000089045 |
| Alley | 0.020407544901 | 0.000000299638 |
| LotConfig | 0.021019364538 | 0.000003163167 |
| Functional | 0.016480385721 | 0.000484169680 |
| Heating | 0.014437135426 | 0.000753472106 |
| MiscFeature | 0.007079752947 | 0.035003671875 |
| Condition2 | 0.009899160716 | 0.043425658361 |
R² de 0.25, pero teniendo en cuenta que como en las variables numéricas no había normalidad y para la correlacion use el método de Spearman que suele dar un valor ligeramente superior al de Pearson, en este caso voy a escoger también las dos variables que se han quedado a las puertas con 0.24
`Neighborhood` ubicaciones físicas dentro de los límites de la ciudad de Ames
Tiene 25 categorias
`MSSubClass` la clase de construcción. Tiene 16 categorias
`Foundation` tipo de cimientos. Tiene 6 categorias
`GarageType` ubicación del garaje Tiene 7 categorias
Son un total de 54 categorias.
Si usamos one hot encoding suponen (25-1)+(16-1)+(6-1)+(7-1)=50 nuevas variables a añadir a las 11 numericas que ya tenemos.
Hay que reducirlas
Las revisamos
En cada columna aparecen las observaciones
En cada columna aparecen las observaciones
Voy a intentar reducir las variables.
Para eso voy a utilizar una clasificación jerarquica aglomerativa sencilla mediante hclust
Voy a realizar varias clasificaciones y recalcular el coeficiente de determinación que quedaria antes de decidir .
Los clusters que elegimos van de 3 a 8 agrupaciones
Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES
En cada columna aparecen las observaciones
En cada columna aparecen las observaciones
Realizamos la misma operación que con el vecindario, solo que aquí tenemos 6 grupos por lo que los cluster que elegimos van de 2 a 5
Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES
En cada columna aparecen las observaciones
En cada columna aparecen las observaciones
Realizamos la misma operación que con el vecindario, solo que aquí tenemos 7 grupos por lo que los cluster que elegiremos van de 2 a 5
Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES
En cada columna aparecen las observaciones
En cada columna aparecen las observaciones
Esta variable es mas peculiar.
Veamosla mas detenidamente
| Var1 | Freq |
|---|---|
| 1-STORY 1946 & NEWER ALL STYLES | 536 |
| 1-STORY 1945 & OLDER | 69 |
| 1-STORY W/FINISHED ATTIC ALL AGES | 4 |
| 1-1/2 STORY - UNFINISHED ALL AGES | 12 |
| 1-1/2 STORY FINISHED ALL AGES | 144 |
| 2-STORY 1946 & NEWER | 299 |
| 2-STORY 1945 & OLDER | 60 |
| 2-1/2 STORY ALL AGES | 16 |
| SPLIT OR MULTI-LEVEL | 58 |
| SPLIT FOYER | 20 |
| DUPLEX - ALL STYLES AND AGES | 52 |
| 1-STORY PUD (Planned Unit Development) - 1946 & NEWER | 87 |
| 1-1/2 STORY PUD - ALL AGES | 0 |
| 2-STORY PUD - 1946 & NEWER | 63 |
| PUD - MULTILEVEL - INCL SPLIT LEV/FOYER | 10 |
| 2 FAMILY CONVERSION - ALL STYLES AND AGES | 30 |
Tenemos una categoria con 0 casos en el Train
Test| Var1 | Freq |
|---|---|
| 1-STORY 1946 & NEWER ALL STYLES | 543 |
| 1-STORY 1945 & OLDER | 70 |
| 1-STORY W/FINISHED ATTIC ALL AGES | 2 |
| 1-1/2 STORY - UNFINISHED ALL AGES | 6 |
| 1-1/2 STORY FINISHED ALL AGES | 143 |
| 2-STORY 1946 & NEWER | 276 |
| 2-STORY 1945 & OLDER | 68 |
| 2-1/2 STORY ALL AGES | 7 |
| SPLIT OR MULTI-LEVEL | 60 |
| SPLIT FOYER | 28 |
| DUPLEX - ALL STYLES AND AGES | 57 |
| 1-STORY PUD (Planned Unit Development) - 1946 & NEWER | 95 |
| 1-1/2 STORY PUD - ALL AGES | 1 |
| 2-STORY PUD - 1946 & NEWER | 65 |
| PUD - MULTILEVEL - INCL SPLIT LEV/FOYER | 7 |
| 2 FAMILY CONVERSION - ALL STYLES AND AGES | 31 |
Id del nivel buscado
Id
1 2819
Tiene 1 caso, luego no se puede eliminar directamente de todo el conjunto, pero si debemos NO tomarlo en consideracion para la reduccion de variables porque si no trastornaria todos los calculos
level para el calculo| Var1 | Freq |
|---|---|
| 1-STORY 1946 & NEWER ALL STYLES | 536 |
| 1-STORY 1945 & OLDER | 69 |
| 1-STORY W/FINISHED ATTIC ALL AGES | 4 |
| 1-1/2 STORY - UNFINISHED ALL AGES | 12 |
| 1-1/2 STORY FINISHED ALL AGES | 144 |
| 2-STORY 1946 & NEWER | 299 |
| 2-STORY 1945 & OLDER | 60 |
| 2-1/2 STORY ALL AGES | 16 |
| SPLIT OR MULTI-LEVEL | 58 |
| SPLIT FOYER | 20 |
| DUPLEX - ALL STYLES AND AGES | 52 |
| 1-STORY PUD (Planned Unit Development) - 1946 & NEWER | 87 |
| 2-STORY PUD - 1946 & NEWER | 63 |
| PUD - MULTILEVEL - INCL SPLIT LEV/FOYER | 10 |
| 2 FAMILY CONVERSION - ALL STYLES AND AGES | 30 |
Podemos ver que ya no figura
Realizamos la misma operación que con el vecindario, solo que aquí tenemos 16 (15 con la que no tratamos transitoriamente) grupos por lo que los cluster que elegiremos van de 3 a 8
Los resultados los presento juntas las cuatro variables en 6. CONCLUSIONES
He obtenido en las siguientes tablas los coeficientes de determinación de las variables agrupadas en diferentes clusters.
Tambien figura el valor del que partíamos bajo el epigrafe Todos
La idea es optimizar el numero que nos quedaremos teniendo en cuenta que ya tenemos 11 variables numéricas
Lo primero mas destacable que se observa es que no hay diferencias tomando la media o la mediana de los precios en la variable GarageType.
Esto se explica porque el dendograma es idéntico en ambos supuestos. Aqui se puede ver
Lo segundo que destaca es que en la gran mayoría de los supuestos tomar como referencia la media del precio suele ser mejor que hacerlo con la mediana. La diferencia es positiva en la mayoría de los casos.
Descartamos trabajar con la mediana
Como criterios:
En primer lugar seguir el orden asignado por el coeficiente de determinación general. Tendran preferencias las categorías de Neighborhood, sobre el resto, luego Foundation, GarageType y por ultimo MSSubClass
Luego elegir aquel agrupamiento en que el paso a un numero de cluster menor suponga una diferencia muy superior a la que supuso el paso anterior (de un numero de clusters mayor). Veremos todo en una tabla con una vista mas amigable
| Numero clusters | R2 Media | R2 Mediana | Diferencia_Media_Mediana |
|---|---|---|---|
| 3 | 0.510288922673946 | 0.510288922673946 | 0 |
| 4 | 0.520752826029343 | 0.519728064432752 | 0.00102476159659104 |
| 5 | 0.534661463050312 | 0.533467614063988 | 0.00119384898632402 |
| 6 | 0.536798653780542 | 0.533811092372337 | 0.002987561408205 |
| 7 | 0.541121980460839 | 0.539159180649222 | 0.00196279981161707 |
| 8 | 0.542448822452204 | 0.54101354304445 | 0.00143527940775401 |
| Todos | 0.545574990809563 | 0.545574990809563 | 0 |
Marco la fila de las casillas de salto mas grandes en amarillo.
Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 4 clusters y elegimos 5
| Numero clusters | R2 Media | R2 Mediana | Diferencia_Media_Mediana |
|---|---|---|---|
| 2 | 0.0568254698693131 | 0.247754678851469 | -0.190929208982156 |
| 3 | 0.254395725745173 | 0.248262307945321 | 0.00613341779985199 |
| 4 | 0.2548092461983 | 0.252170668995711 | 0.00263857720258898 |
| 5 | 0.256199967397587 | 0.255658927697032 | 0.000541039700554968 |
| Todos | 0.256368401530415 | 0.256368401530415 | 0 |
Descartamos primero aquellas con un coeficiente muy bajo.
Las tacho en naranja. Ese es el minimo
En este caso 2 clusters
Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 4 clusters y elegimos 5
| Numero clusters | R2 Media | R2 Mediana | Diferencia_Media_Mediana |
|---|---|---|---|
| 2 | 0.216280939876281 | 0.216280939876281 | 0 |
| 3 | 0.224281569646271 | 0.224281569646271 | 0 |
| 4 | 0.247622864331931 | 0.247622864331931 | 0 |
| 5 | 0.249122673737389 | 0.249122673737389 | 0 |
| Todos | 0.249204230504291 | 0.249204230504291 | 0 |
Descartamos primero aquellas con un coeficiente muy bajo.
Las tacho en naranja. Ese es el minimo
En este caso 3 clusters
Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 3 clusters. El mismo que techamos en naranja. Elegimos 4
| Numero clusters | R2 Media | R2 Mediana | Diferencia_Media_Mediana |
|---|---|---|---|
| 3 | 0.174786074913226 | 0.188741697652476 | -0.01395562273925 |
| 4 | 0.235584333942853 | 0.230629760361157 | 0.00495457358169599 |
| 5 | 0.239410301887266 | 0.241858637138703 | -0.00244833525143701 |
| 6 | 0.243776881430928 | 0.241878911205326 | 0.00189797022560198 |
| 7 | 0.245698829986421 | 0.241915556005449 | 0.003783273980972 |
| 8 | 0.24576269922555 | 0.242459440131863 | 0.00330325909368701 |
| Todos | 0.246315972817565 | 0.246315972817565 | 0 |
Descartamos primero aquellas con un coeficiente muy bajo.
Las tacho en naranja. Ese es el minimo
En este caso 3 clusters
Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 5 clusters. Elegimos 6
Tenemos que la primera elección es :
Vecinos: 5 clusters sobre 25 categorias Correlacion ~0.7312
Cimientos 5 clusters sobre 6 categorias Correlacion ~0.5061
Garaje 4 clusters sobre 7 categorias Correlacion~0.4976
Clases 6 clusters sobre 16 categorias Correlacion ~0.4937
Son un total de 20 categorias.
En las dos ultimas (Garage y Clases ) parece difícil reducir mas sin que haya una perdida importante, y ya están muy al limite.
Quizas podríamos reducir uno o dos mas en Cimientos, pero la cantidad de 31 variables numéricas , entre las originales y las reconvertidas puede ser una buena cifra
Para realizar la actualización recuperamos parte del código con el numero cluster que hemos decidido en Neighborhood, Foundation y GarageType.
MSSUBCLASS.
Para el caso de la variable MSSubClass tenemos que recordar que para hacer la agrupación teníamos una categoría que se encontraba en el dataset Test pero no en el Train, luego dejamos esa categoría apartada , pero ahora hay que introducirla manualmente en un cluster.
Para encontrar en que cluster voy a buscar registros con ciertas variables muy correlacionadas con el objetivo y que se parezcan a las del que buscamos.
Voy a usar las variables numéricas Habitat, AreaPiso y OverallQual
Primero identificaremos el registro del Test
| Id | AreaPiso | Habitat | OverallQual |
|---|---|---|---|
| 2819 | 0.09323653 | 0.17182298 | 0.66666667 |
A continuacion escogemos las ventanas de los parametros para el filtrado
0.06<AreaPiso<0.12
0.16<Habitat<0.18
0.6<OverallQual<0.7
prue<-total%>%filter(OverallQual>0.6 & OverallQual<0.7)%>%select(Id,AreaPiso,Habitat,MSSubClass)
prue<-prue%>%filter(AreaPiso>0.06 & AreaPiso<0.12)
prue<-prue%>%filter(Habitat>0.16 & Habitat<0.18)%>%select(Id,MSSubClass)| Var1 | Freq |
|---|---|
| 1-STORY 1946 & NEWER ALL STYLES | 0 |
| 1-STORY 1945 & OLDER | 0 |
| 1-STORY W/FINISHED ATTIC ALL AGES | 0 |
| 1-1/2 STORY - UNFINISHED ALL AGES | 0 |
| 1-1/2 STORY FINISHED ALL AGES | 0 |
| 2-STORY 1946 & NEWER | 9 |
| 2-STORY 1945 & OLDER | 0 |
| 2-1/2 STORY ALL AGES | 0 |
| SPLIT OR MULTI-LEVEL | 1 |
| SPLIT FOYER | 0 |
| DUPLEX - ALL STYLES AND AGES | 0 |
| 1-STORY PUD (Planned Unit Development) - 1946 & NEWER | 0 |
| 1-1/2 STORY PUD - ALL AGES | 1 |
| 2-STORY PUD - 1946 & NEWER | 0 |
| PUD - MULTILEVEL - INCL SPLIT LEV/FOYER | 0 |
| 2 FAMILY CONVERSION - ALL STYLES AND AGES | 0 |
Hay 11 registros con campos parecidos, incluido el que buscamos.
La gran mayoría 9 tienen en MSSubClass-> 2-STORY 1946 & NEWER.
Donde esté esta categoría agrupada pondremos la que nos falta con parte del mismo codigo usado en las variables anteriores
Hasta aquí es todo igual en el codigo que en n las variables anteriores.
Vamos a buscar en que grupo queda 2-STORY 1946 & NEWER que es donde hay que meter el nivel de factor que nos falta
| train.dat | V2 |
|---|---|
| 1-STORY 1946 & NEWER ALL STYLES | Clase1 |
| 1-STORY 1945 & OLDER | Clase2 |
| 1-STORY W/FINISHED ATTIC ALL AGES | Clase3 |
| 1-1/2 STORY - UNFINISHED ALL AGES | Clase2 |
| 1-1/2 STORY FINISHED ALL AGES | Clase3 |
| 2-STORY 1946 & NEWER | Clase4 |
| 2-STORY 1945 & OLDER | Clase5 |
| 2-1/2 STORY ALL AGES | Clase1 |
| SPLIT OR MULTI-LEVEL | Clase5 |
| SPLIT FOYER | Clase3 |
| DUPLEX - ALL STYLES AND AGES | Clase6 |
| 1-STORY PUD (Planned Unit Development) - 1946 & NEWER | Clase1 |
| 2-STORY PUD - 1946 & NEWER | Clase6 |
| PUD - MULTILEVEL - INCL SPLIT LEV/FOYER | Clase2 |
| 2 FAMILY CONVERSION - ALL STYLES AND AGES | Clase6 |
Es el elemento numero 6 que corresponde al cluster Clase4
levels(total$MSSubClass) [1] "1-STORY 1946 & NEWER ALL STYLES"
[2] "1-STORY 1945 & OLDER"
[3] "1-STORY W/FINISHED ATTIC ALL AGES"
[4] "1-1/2 STORY - UNFINISHED ALL AGES"
[5] "1-1/2 STORY FINISHED ALL AGES"
[6] "2-STORY 1946 & NEWER"
[7] "2-STORY 1945 & OLDER"
[8] "2-1/2 STORY ALL AGES"
[9] "SPLIT OR MULTI-LEVEL"
[10] "SPLIT FOYER"
[11] "DUPLEX - ALL STYLES AND AGES"
[12] "1-STORY PUD (Planned Unit Development) - 1946 & NEWER"
[13] "1-1/2 STORY PUD - ALL AGES"
[14] "2-STORY PUD - 1946 & NEWER"
[15] "PUD - MULTILEVEL - INCL SPLIT LEV/FOYER"
[16] "2 FAMILY CONVERSION - ALL STYLES AND AGES"
1-1/2 STORY PUD - ALL AGES tiene que ir en la posicion numero 13.
#Añado el level
levels(train.dat$train.dat)<-c(levels(train.dat$train.dat),'1-1/2 STORY PUD - ALL AGES')
#Añado la fila
train.dat<-rbind(train.dat,c('1-1/2 STORY PUD - ALL AGES','Clase4'))
#Cojo levels originales como vector
lev<-as.vector(levels(total$MSSubClass))
#Comparo y ordeno
train.dat<-train.dat[match(lev,train.dat$train.dat),]
#Ya estan ordenados los level y los valores que les sutituyen
levels(TotalFact$MSSubClassMean4)<-train.dat$V2
total$Clases<-TotalFact$MSSubClassMean4
Para buscar el modelo que mas conviene tomar para realizar la prediccion que se pide voy a dividir el conjunto de predictores en varias partes.
Por un lado aquellos predictores que son desde el origen numéricos y que además son continuos o discretos con un numero amplio de intervalos
Son :Antiguedad, AntGarage, AreaPiso, GarageTotal, Habitat y OverallQual
En otro grupo los predictores numéricos de origen ordinal con un numero pequeño de intevalos.
Son : BsmtQual, ExterQual, FireplaceQu, GarageFinish y KitchenQual
En el ultimo grupo los predictores de origen categoricos
Son : Neighborhood, Foundation, GarageType y MSSubClass
Esta división solo la hago en sentido grafico para apreciar mejor las diversas características
Voy a aplicar un modelo lineal multiple, uno polinómico, otro suavizado tipo Loess y uno suavizado con curvas Spline y vamos a comparar en cada variable con respecto a la objetivo SalePrice
Aunque el grafico es muy completo entre toda las variables solos nos interesa la fila inferior donde aparecen los graficos de cada predictor en función del objetivo
Podemos ver también en las primeras graficas en la columna mas a la derecha el valor de correlacion de SalePrice con el resto de variables
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Se adapta mejor la curva suavizada que la recta
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
La especificidad de los datos (como poner antigüedad a los que no tienen garaje) hace que salga una grafica extraña, pero me decanto por el modelo lineal
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Los outliers hacen que las curvas no sirvan, pero sin ellos podria ser la opcion adecuada
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Pasa algo parecido que con la antigüedad. Se adapta mejor una curva
Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo
Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente
Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo
Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente
El metodo de regresion local LOESS no es aceptable en estas variables
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
Se adapta mejor la curva suavizada que la recta
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
Se adapta mejor la curva suavizada que la recta
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
No esta tan claro que tipo se adapta mejor. Se vera numericamente
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
No esta tan claro que tipo se adapta mejor. Se vera numericamente
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
Se adapta mejor la curva suavizada que la recta
En cuanto a las variables categoricas , no se puede hacer ningún análisis grafico de lineas de regresion por la propia composición de la variable.
Si podemos ver una matriz de graficos de sus variables origen ordenadas por la variable destino
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Es posible eliminar un cluster mas en Cimientos como se había apuntado, pero ahora se ve mejor
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
| Numero clusters | R2 Media | R2 Mediana | Diferencia_Media_Mediana |
|---|---|---|---|
| 2 | 0.0568254698693131 | 0.247754678851469 | -0.190929208982156 |
| 3 | 0.254395725745173 | 0.248262307945321 | 0.00613341779985199 |
| 4 | 0.2548092461983 | 0.252170668995711 | 0.00263857720258898 |
| 5 | 0.256199967397587 | 0.255658927697032 | 0.000541039700554968 |
| Todos | 0.256368401530415 | 0.256368401530415 | 0 |
Graficamente la mejor opcion es n=3.
Ademas vimos en la sección anterior que no había tanta diferencia
dummy#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact1<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact1$Id<-total$Id
#Conversion a Dummys
Total.dummy.B<-TotalFact1%>%select(Id,B=Vecindario)
Total.dummy.C<-TotalFact1%>%select(Id,C=Cimientos)
Total.dummy.G<-TotalFact1%>%select(Id,G=UbicaGarage)
Total.dummy.N<-TotalFact1%>%select(Id,N=Clases)
modelo1.B<-as.data.frame(model.matrix(~.,Total.dummy.B))
modelo1.C<-as.data.frame(model.matrix(~.,Total.dummy.C))
modelo1.G<-as.data.frame(model.matrix(~.,Total.dummy.G))
modelo1.N<-as.data.frame(model.matrix(~.,Total.dummy.N))
modelo1.B$`(Intercept)`<-NULL
modelo1.C$`(Intercept)`<-NULL
modelo1.G$`(Intercept)`<-NULL
modelo1.N$`(Intercept)`<-NULL
modelo1<-modelo1.B
modelo1<-cbind(modelo1,modelo1.C%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.G%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.N%>%select(-Id))
#Modelo con dummys
Cuant<-total%>%select(Antiguedad,AntGarage,AreaPiso,BsmtQual,ExterQual,FireplaceQu,GarageFinish,GarageTotal,Habitat,KitchenQual,OverallQual,SalePrice)
modelo1.dummy<-cbind(modelo1,Cuant)
#Modelo con variables categoricas
Total.dummy<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases)
modelo1.Nodummy<-cbind(Total.dummy,Cuant)
Si recordamos encontramos dos valores outliers .
El registro 524 que tenia discordancia entre los años de construcción, remodelación y venta (corregido) y además tenia un precio muy bajo para el área habitable en sotano y primer piso.
Eso mismo le pasaba al registro 1299 que tenia un precio muy bajo para el área habitable y además no tenia proporción entre el área habitable, las habitaciones y los baños
En principio tenia pensado dejarles por que además en común con estos dos teniamos el registro 2550 que tenia discordancia en los años y falta de proporción entre el área habitable, las habitaciones y los baños, y este registro esta en el Test, pero he creido mas conveniente eliminarles de los datos
Antes de eliminarlos vamos a comprobar que posición ocupan en las variables numéricas normalizadas porque si son el valor extremo, máximo o minimo , al eliminarlo deberemos volver a normalizar esa variable con el nuevo extremo
| Id | Antiguedad | AntGarage | AreaPiso | GarageTotal | Habitat | OverallQual |
|---|---|---|---|---|---|---|
| 524 | 0 | 0 | 0.5676347 | 0.35645161 | 0.75770895 | 1 |
| Id | Antiguedad | AntGarage | AreaPiso | GarageTotal | Habitat | OverallQual |
|---|---|---|---|---|---|---|
| 1299 | 0 | 0 | 1 | 0.3811828 | 0.91658963 | 1 |
#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=524)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1299)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=524)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1299)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)
modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)Tanto Antigüedad como AntGarage ,y OverallQuall tienen varios registros con el mismo valor que el que vamos a eliminar, .
Sin embargo en AreaPiso el registro 1299 es el máximo. Cuando le eliminemos hay que normalizar de nuevo
Realizaremos una comprobacion grafica de las variables mas afectadas por los outliers que vimos en la seccion anterior
Afectaban sobre todo a AreaPiso, GarageTotal y Habitat.
AreaPiso antesCon los outliers que distorsionaban la curva
AreaPiso despuesHan mejorado
GarageTotal antesCon los outliers que distorsionaban la curva
GarageTotal despuesTenemos otros outliers que aparecen en GarageTotal
Habitat antesCon los outliers que distorsionaban la curva
Habitat despuesHan mejorado
GarageTotal y vemos su influencia en AreaPiso (puntos en rojo)No tienen una gran influencia, ni su mantenimiento, ni su eliminacion
GarageTotal y vemos su influencia en Habitat (puntos en rojo)No tienen una gran influencia, ni su mantenimiento, ni su eliminacion
| Id |
|---|
| 582 |
| 1062 |
| 1191 |
| 1351 |
#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=582)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1062)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1191)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1351)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=582)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1062)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1191)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1351)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)
modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)Volvemos a cargar los graficos y comparamos
AreaPiso antes segundos outliersAreaPiso despues segundos outliersGarageTotal antes segundos outliersCon los outliers que distorsionaban la curva
GarageTotal despues segundos outliersVemos como ha mejorado bastante
Habitat antes segundos outliersHabitat despues segundos outliers
Vamos a realizar un filtrado de las variables mediante el método sbf() del paquete caret
Vamos a realizarlo con dos funciones internas diferentes para poder comparar y validar los resultados , ramdom forest y modelo lineal
#FILTRADO DE VARIABLES CON CARET
#Filtrado con sbf de caret usando RandomForest y Linear Model
# Se crea una semilla para cada partición y cada repetición: el vector debe
# tener B+1 semillas donde B = particiones * repeticiones.
ModeloTrain.Nodummy<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
set.seed(456)
particiones = 10
repeticiones = 5
seeds <- sample.int(1000, particiones * repeticiones + 1)
# Control del filtrado Random Forest
ctrl_filtrado.rf <- sbfControl(functions = rfSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)
# Control del filtrado Linear Model
ctrl_filtrado.lm <- sbfControl(functions = lmSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)
set.seed(234)
rf_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.rf,ntree = 500)
lm_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.lm) Podemos apreciar que los resultados son iguales
De las 25 variables solo se ha descartado 1 Clase5. Las que quedan aparecen en las tablas inferiores para los distintos modelos
Aplicamos los resultado y eliminamos variable no influyente
| x |
|---|
| VecindarioBarrio2 |
| VecindarioBarrio3 |
| VecindarioBarrio4 |
| VecindarioBarrio5 |
| CimientosCimientos2 |
| CimientosCimientos3 |
| UbicaGarageGarage2 |
| UbicaGarageGarage3 |
| UbicaGarageGarage4 |
| ClasesClase2 |
| ClasesClase3 |
| ClasesClase4 |
| ClasesClase6 |
| Antiguedad |
| AntGarage |
| AreaPiso |
| BsmtQual |
| ExterQual |
| FireplaceQu |
| GarageFinish |
| GarageTotal |
| Habitat |
| KitchenQual |
| OverallQual |
| x |
|---|
| VecindarioBarrio2 |
| VecindarioBarrio3 |
| VecindarioBarrio4 |
| VecindarioBarrio5 |
| CimientosCimientos2 |
| CimientosCimientos3 |
| UbicaGarageGarage2 |
| UbicaGarageGarage3 |
| UbicaGarageGarage4 |
| ClasesClase2 |
| ClasesClase3 |
| ClasesClase4 |
| ClasesClase6 |
| Antiguedad |
| AntGarage |
| AreaPiso |
| BsmtQual |
| ExterQual |
| FireplaceQu |
| GarageFinish |
| GarageTotal |
| Habitat |
| KitchenQual |
| OverallQual |
Antes de empezar a aplicar modelos tenemos que eliminar la variable Id de ambos dataset, pero guardando una copia para poder enviar la respuesta
Para la fijación de nuestro modelo vamos a elegir el método de la validación cruzada del dataset Train con 20 iteraciones
No sabiendo que modelo elegir, para lo cual probaremos con el método train() del paquete caret diversos modelos y veremos que resultados nos aportan
Una cosa interesante que aporta este metodo es que llama a los diversos metodos de distintos paquetes con diferentes hiperparametros y se encarga de seleccionar los parametros propios de cada metodo mas eficientes
#PRUEBAS MODELOS
set.seed(234)
#MultiVariate Adaptative Regression Splines
MARS<-train(TrainFinal[,-25],TrainFinal[,25],'gcvEarth',trControl = trainControl(method = 'cv',number = 20))
#Modelo lineal
LM<-train(TrainFinal[,-25],TrainFinal[,25],'lm',trControl = trainControl(method = 'cv',number = 20))
#Ramdom Forest
RF<-train(TrainFinal[,-25],TrainFinal[,25],'ranger',trControl = trainControl(method = 'cv',number = 20))
#Modelo lineal
rlm<-lm(formula = SalePrice~.,data=TrainFinal)
#Regression splines
rnd<-lm(formula=SalePrice~bs(Antiguedad)+bs(OverallQual)+bs(BsmtQual)+bs(ExterQual)+bs(FireplaceQu)+bs(GarageFinish)+bs(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)
#Natural splines
rnd2<-lm(formula=SalePrice~ns(Antiguedad)+ns(OverallQual)+ns(BsmtQual)+ns(ExterQual)+ns(FireplaceQu)+ns(GarageFinish)+ns(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)
#Generalized Additice Model using SPLINE
GAMS<-train(TrainFinal[,-25],TrainFinal[,25],'gamSpline',trControl = trainControl(method = 'cv',number = 20))
#Generalize Linear Models
GLM<-train(TrainFinal[,-25],TrainFinal[,25],'glm',trControl = trainControl(method = 'cv',number = 20))
#Bayesian Ridge Regression
BRR<-train(TrainFinal[,-25],TrainFinal[,25],'bridge',trControl = trainControl(method = 'cv',number = 20))
#Bayesian Ridge Regression (Model Averaged)
BLASSO<-train(TrainFinal[,-25],TrainFinal[,25],'blassoAveraged',trControl = trainControl(method = 'cv',number = 20))
#Extreme gradient boosting
XGB<-train(TrainFinal[,-25],TrainFinal[,25],'xgbLinear',trControl = trainControl(method = 'cv',number = 20))
XGBT<-train(TrainFinal[,-25],TrainFinal[,25],'xgbTree',trControl = trainControl(method = 'cv',number = 20))#Comprobacion resultados
options(digits=6)
model<-list(gcvEarth=MARS,lm=LM,ranger=RF,gamSpline=GAMS,glm=GLM,bridge=BRR,blassoAveraged=BLASSO,xgbLinear=XGB,xgbTree=XGBT)
result.resamples<-resamples(model)
#Resutados
metricas_resamples <- result.resamples$values%>%gather(key = "modelo", value = "valor", -Resample)%>%separate(col = "modelo", into = c("modelo", "metrica"), sep = "~", remove = TRUE)| modelo | MAE | RMSE | Rsquared |
|---|---|---|---|
| xgbTree | 17900.3 | 25888.2 | 0.891002 |
| ranger | 17796.4 | 26444.9 | 0.890143 |
| gcvEarth | 18527.0 | 26813.4 | 0.882849 |
| gamSpline | 19205.6 | 27160.8 | 0.882141 |
| xgbLinear | 19324.2 | 27388.8 | 0.881359 |
| bridge | 20573.4 | 29588.9 | 0.864643 |
| blassoAveraged | 20444.0 | 29604.4 | 0.864640 |
| lm | 20440.4 | 29307.8 | 0.863801 |
| glm | 20408.2 | 29537.1 | 0.862450 |
MAE: Mean Absolute Error. Media de errores absolutos
RMSE: Root Mean Squared Error. Raiz cuadradra de la media de los residuos al cuadrado.
RSquared: Bondad del ajuste. Es la relacion entre la suma de los cuadrados de regresion y la suma total de cuadrados.
Aunque el uso de un tipo de indicador u otro favorece ciertas caracteristicas en cada modelo, parece claro que hay dos que estan por encima de los demas en todos los indicadores
Rsquared.Los modelos que parecen mas efectivos son RandomForest, y xgbTree
ranger: RandomForest es un ensamble en paralelo (bagging) de arboles de predicción en los que se selecciona aleatoriamente los predictores en cada nodo
xgbTree: eXtreme Gradient Boosting es un ensamble secuencial (boosting) de arboles de predicción en el que cada árbol intenta minimizar los residuos del anterior
Los otros modelos que también dan buenos resultados son:
GAMSpline :Generalized Additive Model using Splines es una combinacion lineal de funciones no lineales.Se trata de combinar distintos tipos de regresión en un conjunto no lineal, usando aquí smooth Splines
gvcEarth: MultiVariate Adaptative Regression Splines es parecido al anterior pero usando regression splines
XGBLinear es un un ensamble secuencial como XGBoost pero orientado hacia el modelo lineal
En un data frame elijo en varias columnas las predicciones que me da cada modelo
#Calculos previos para ponderaciones
RS<-metricas_resamples%>%filter(metrica=="Rsquared") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared))
RSM<-metricas_resamples%>%filter(metrica=="MAE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(MAE))
RSE<-metricas_resamples%>%filter(metrica=="RMSE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(RMSE))
RST<-RS%>%spread(modelo,Rsquared)
RSMT<-RSM%>%spread(modelo,MAE)
RSET<-RSE%>%spread(modelo,RMSE)
#Calculo para distintas ponderaciones
SumaRs<-RST$ranger+RST$gamSpline+RST$xgbTree+RST$gcvEarth+RST$xgbLinear
SumaRSM<-((1/RSMT$ranger)+(1/RSMT$gamSpline)+(1/RSMT$xgbTree)+(1/RSMT$gcvEarth)+(1/RSMT$xgbLinear))
SumaRSE<-((1/RSET$ranger)+(1/RSET$gamSpline)+(1/RSET$xgbTree)+(1/RSET$gcvEarth)+(1/RSET$xgbLinear))#Prediccion
result<-CopiaTest%>%select(-SalePrice)
result$RF<-predict(RF,TestFinal)
result$GAM<-predict(GAMS,TestFinal)
result$XGBT<-predict(XGBT,TestFinal)
result$MARS <-predict(MARS,TestFinal)
result$XGB <-predict(XGB,TestFinal)
result$media<-round(((result$RF+result$GAM+result$XGBT+result$MARS+result$XGB)/5),digits = 1)
#ponderada sobre Rsquared
result$ponderada<-round((((result$RF*RST$ranger)+(result$GAM*RST$gamSpline)+(result$XGBT*RST$xgbTree)+(result$MARS*RST$gcvEarth)+(result$XGB*RST$xgbLinear))/SumaRs),digits = 1)
#Ponderada sobre MAE
result$ponderada1<-round((((result$RF/RSMT$ranger)+(result$GAM/RSMT$gamSpline)+(result$XGBT/RSMT$xgbTree)+(result$MARS/RSMT$gcvEarth)+(result$XGB/RSMT$xgbLinear))/SumaRSM),digits = 1)
#Ponderada sobre RMSE
result$ponderada2<-round((((result$RF/RSET$ranger)+(result$GAM/RSET$gamSpline)+(result$XGBT/RSET$xgbTree)+(result$MARS/RSET$gcvEarth)+(result$XGB/RSET$xgbLinear))/SumaRSE),digits = 1)
#Redondeo hacia arriba en centenas de los valores
result$RF<-100*ceiling((result$RF/100))
result$GAM<-100*ceiling((result$GAM/100))
result$XGBT<-100*ceiling((result$XGBT/100))
result$MARS<-100*ceiling((result$MARS/100))
result$XGB<-100*ceiling((result$XGB/100))
result$media<-100*ceiling((result$media/100))
result$ponderada<-100*ceiling((result$ponderada/100))
result$ponderada1<-100*ceiling((result$ponderada1/100))
result$ponderada2<-100*ceiling((result$ponderada2/100))Fin<-result%>%select(Id,SalePrice=media)
Fin1<-result%>%select(Id,SalePrice=RF)
Fin2<-result%>%select(Id,SalePrice=GAM)
Fin3<-result%>%select(Id,SalePrice=XGBT)
Fin4<-result%>%select(Id,SalePrice=MARS)
Fin5<-result%>%select(Id,SalePrice=XGB)
Fin6<-result%>%select(Id,SalePrice=ponderada)
Fin7<-result%>%select(Id,SalePrice=ponderada1)
Fin8<-result%>%select(Id,SalePrice=ponderada2)
write.csv(Fin,file="Ames2_house.csv",row.names = FALSE)
write.csv(Fin1,file="Ames2_house1.csv",row.names = FALSE)
write.csv(Fin2,file="Ames2_house2.csv",row.names = FALSE)
write.csv(Fin3,file="Ames2_house3.csv",row.names = FALSE)
write.csv(Fin4,file="Ames2_house4.csv",row.names = FALSE)
write.csv(Fin5,file="Ames2_house5.csv",row.names = FALSE)
write.csv(Fin6,file="Ames2_house6.csv",row.names = FALSE)
write.csv(Fin7,file="Ames2_house7.csv",row.names = FALSE)
write.csv(Fin8,file="Ames2_house8.csv",row.names = FALSE)Estos son los resultado en KAGGLE
El valor corresponde al resultado aplicado al TEST que nos da RMSLE: Root Mean Squared Logarithmic Error similar al RMSE pero aplicando una reduccion logaritmica previa a los datos
Podemos apreciar que los valores son muy parecidos tanto en la media directa de los modelos escogidos como en aquella ponderacion con el criterio que sea
Aunque se mantiene el orden de eficiencia que habiamos obtenido de los modelos durante el entrenamiento , hay que destacar que cualquier mezcla de varios sea con el criterio que sea de ponderacion es mejor que el mejor de los modelos en solitario
---
title: "TFM"
output:
flexdashboard::flex_dashboard:
theme: united
highlight: haddock
source_code: embed
---
```{r setup, include=FALSE, message=FALSE,warning=FALSE}
library(flexdashboard)
library(dplyr)
library(kableExtra)
library(ggplot2)
library(knitr)
library(corrplot)
library(FactoMineR)
library(GGally)
library(ggdendro)
library(caret)
library(splines)
library(tidyr)
options(knitr.table.format = "html")
#Funciones para los graficos
give.n <- function(x,n){
return(c(y = mean(x)*1.5, label = length(x)))
}
give1.n<-function(x,n){
return(c(y = mean(x)*1.5, label = length(x)))
}
my_rg1 <- function(data, mapping, ...){
p <- ggplot(data = data, mapping = mapping) +
geom_point() +
geom_smooth(method='loess', fill="red", color="red",se=FALSE) +
geom_smooth(method='lm', fill="cyan", color="cyan",se=FALSE)
p
}
my_rg2 <- function(data, mapping, ...){
p <- ggplot(data = data,mapping=mapping) +
geom_point() +
geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkorchid3',color='darkorchid3',se=FALSE) +
geom_smooth(method='lm',formula=y~poly(x),fill='orangered',color='orangered',se=FALSE)
p
}
my_rg3 <- function(data, mapping, ...){
p <- ggplot(data = data, mapping = mapping) +
geom_point() +
geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkgreen',color='darkgreen',alpha=.1) +
geom_smooth(method='loess', fill="firebrick1", color="firebrick1",alpha=.1)
p
}
#Solo para las discretas
my_rg4 <- function(data, mapping, ...){
p <- ggplot(data = data, mapping = mapping) +
geom_point() +
geom_smooth(method='lm',fill='purple',color='purple',alpha=.3)
p
}
#Funcion para regresion
normalize <- function(x) {
return ((x - min(x)) / (max(x) - min(x))) }
```
0 PORTADA {.hidden}
======
**TRABAJO FIN MASTER**
**Big Data y Business Analytics**
**Precios de las vivendas en Ames, IOWA US**
**Victor M. del Canto Godino**
**20 de Septiembre de 2018**
Agradecimientos:
A Erik Bruin y Tanner Carbonati por sus kernels en Kaggle que me ayudaron a decidirme sobre qué hacer y sobre todo , qué no hacer.
A Joaquin Amat Rodrigo por sus explicaciones sobre estadística en Github y Rpubs
1 ESTRUCTURA DE LOS DATOS {vertical_layout=scroll data-navmenu="1 PREPARACION"}
=========
Column {data-width=350}
-----------------------------------------------------------------------
Tenemos un archivo de entrenamiento para realizar un aprendizaje supervisado formado por 1460 casos con 81 variables.
Una de ellas es nuestro objetivo `SalePrice`, y debemos ser capaces de predecir esa variable con el dataframe `Test` que se nos proporciona, que es de 1459 casos.
Otra variable importante es la primera `Id` que nos identifica de manera única cada registro.
En el dataframe `Train` tenemos los 1460 primeros.
En el dataframe `Test` tenemos desde el 1461 hasta el 2919
Tenemos varios tipos de variables, como se vera en el siguiente epígrafe, además de las cuales cambiaremos los tipos de algunas.
Hay que realizar una limpieza y control exhaustiva de todos los datos, haciendo énfasis en los valores **NA**
Para realizar una preparación adecuada y buscar un modelo hay que unir los dos dataframe creando los datos que nos faltan en `Test` (`SalePrice` la variable objetivo ) y poniendo como valor **NA**
```{r}
```
Column {vertical_layout=scroll data-width=600}
-----------------------------------------------------------------------
```{r}
url_test="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/test.csv"
url_train="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/train.csv"
train<-read.csv("train.csv",sep = ",", header=TRUE,stringsAsFactors = FALSE)
test<-read.csv("test.csv",sep=",",header=TRUE,stringsAsFactors = FALSE)
```
Sumario, estructura de los dataset y dimensiones
```{r collapse=TRUE,size=8}
summary(train)
```
```{r collapse=TRUE}
str(train)
```
```{r collapse=TRUE}
dim(train)
```
```{r}
AuxTrain<-train
AuxTest<-test
AuxTest$SalePrice<-NA
total<-rbind(AuxTrain,AuxTest)
```
2 VARIABLES {data-orientation=rows data-navmenu="1 PREPARACION"}
========
Row {data-height=60}
---------------
### ESTE TIPO DE VARIABLES SON **CUANTIFICABLES**. PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE
Variables [cuantificables](#variables).
Variables [categoricas](#categoricas) .
Variables [cuantificadas](#cuantificadas)
Row {vertical_layout=fill}
-------------
### .
Codigo | Significado
--------------|---------------------------------------------------
ID | Identidad
LotFrontage | pies lineales de la calle conectados a la propiedad
LotArea | Tamaño del lote en pies cuadrados
YearBuilt | fecha de construcción original
YearRemodAdd | fecha de remodelación
MasVnrArea | área de chapa de la albañilería en pies cuadrados
BsmtFinSF1 | Tipo 1 pies cuadrados terminados
BsmtFinSF2 | Tipo 2 pies cuadrados terminados
BsmtUnfSF | Pies cuadrados sin terminar del área del sótano
TotalBsmtSF | pies cuadrados totales del área del sótano
1stFlrSF | primer piso pies cuadrados
2ndFlrSF | segundo piso pies cuadrados
LowQualFinSF | Pies cuadrados terminados de baja calidad (todos los pisos)
GrLivArea | pies cuadrados del área habitable sobre el nivel del suelo
BsmtFullBath | baños completos en el sótano
BsmtHalfBath | medio baño en el sótano
FullBath | baños completos por encima del grado
HalfBath | medio baño por encima del grado
### .
Codigo | Significado
--------------|---------------------------------------------------
Bedroom | Número de habitaciones sobre el nivel del sótano
Kitchen | Número de cocinas
TotRmsAbvGrd | Total de habitaciones por encima del grado (no incluye baños)
Fireplaces | cantidad de chimeneas
GarageYrBlt | año de garaje fue construido
GarageCars | tamaño del garaje en la capacidad del automóvil
GarageArea | Tamaño del garaje en pies cuadrados
WoodDeckSF | área de cubierta de madera en pies cuadrados
OpenPorchSF | área de porche abierto en pies cuadrados
EnclosedPorch | área de porche cerrado en pies cuadrados
3SsnPorch | área del porche de tres estaciones en pies cuadrados
ScreenPorch | área del porche de la pantalla en pies cuadrados
PoolArea | área de la piscina en pies cuadrados
MiscVal | $ Valor de la función miscelánea
MoSold | Mes vendido
YrSold | Año de venta
SalePrice | el precio de venta de la propiedad en dólares.
CATEGORICAS {data-orientation=rows .hidden}
======
Row {data-height=80}
---------------
### ESTE TIPO DE VARIABLES SON **CATEGORICAS** PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE
Variables [cuantificables](#variables).
Variables [categoricas](#categoricas) .
Variables [cuantificadas](#cuantificadas)
Row {vertical_layout=scroll}
------------
### .
> MSZoning
***
> la clasificación general de zonificación
***
Codigo | Tipo
-------------------- | --------------------
A | Agriculture
C | Commercial
FV | Floating Village Residential
I | Industrial
RH | Residential High Density
RL | Residential Low Density
RP | Residential Low Density Park
RM | Residential Medium Density
***
> Street
***
> Tipo de acceso por carretera
***
Codigo | Tipo
-------------------- | --------------------
Grvl | Gravel
Pave | Paved
***
> Alley
***
> tipo de acceso a callejones
***
Codigo | Tipo
-------------------- | --------------------
Grvl | Gravel
Pave | Paved
NA | No alley access
***
> LotShape
***
> forma general de la propiedad
***
Codigo | Tipo
-------------------- | --------------------
Reg | Regular
IR1 | Slightly irregular
IR2 | Moderately Irregular
IR3 | Irregular
***
> LandContour
***
> planitud de la propiedad
***
Codigo | Tipo
-------------------- | --------------------
Lvl | Near Flat/Level
Bnk | Banked - Quick and significant rise from street grade to building
HLS | Hillside - Significant slope from side to side
Low | Depression
***
> Utilities
***
> Tipo de utilidades disponibles
***
Codigo | Tipo
-------------------- | --------------------
AllPub | All public Utilities (E,G,W,& S)
NoSewr | Electricity, Gas, and Water (Septic Tank)
NoSewa | Electricity and Gas Only
ELO | Electricity only
***
> LotConfig
***
> configuración del lote
***
Codigo | Tipo
-------------------- | --------------------
Inside | Inside lot
Corner | Corner lot
CulDSac | Cul-de-sac
FR2 | Frontage on 2 sides of property
FR3 | Frontage on 3 sides of property
***
> LandSlope
***
> Pendiente de la propiedad
***
Codigo | Tipo
-------------------- | --------------------
Gtl | Gentle slope
Mod | Moderate Slope
Sev | Severe Slope
***
> Neighborhood
***
> ubicaciones físicas dentro de los límites de la ciudad de Ames
***
Codigo | Tipo
-------------------- | --------------------
Blmngtn | Bloomington Heights
Blueste | Bluestem
BrDale | Briardale
BrkSide | Brookside
ClearCr | Clear Creek
CollgCr | College Creek
Crawfor | Crawford
Edwards | Edwards
Gilbert | Gilbert
IDOTRR | Iowa DOT and Rail Road
MeadowV | Meadow Village
Mitchel | Mitchell
NAmes | North Ames
NoRidge | Northridge
NPkVill | Northpark Villa
NridgHt | Northridge Heights
NWAmes | Northwest Ames
OldTown | Old Town
SWISU | South & West of Iowa State University
Sawyer | Sawyer
SawyerW | Sawyer West
Somerst | Somerset
StoneBr | Stone Brook
Timber | Timberland
Veenker | Veenker
***
> Condition1
***
> proximidad a la carretera principal o ferrocarril
***
Codigo | Tipo
-------------------- | --------------------
Artery | Adjacent to arterial street
Feedr | Adjacent to feeder street
Norm | Normal
PosA | Adjacent to postive off-site feature
PosN | Near positive off-site feature--park, greenbelt, etc.
RRAe | Adjacent to East-West Railroad
RRAn | Adjacent to North-South Railroad
RRNe | Within 200' of East-West Railroad
RRNn | Within 200' of North-South Railroad
***
> Condition2
***
> proximidad a la carretera principal o ferrocarril (si hay un segundo presente)
***
Codigo | Tipo
-------------------- | --------------------
Artery | Adjacent to arterial street
Feedr | Adjacent to feeder street
Norm | Normal
PosA | Adjacent to postive off-site feature
PosN | Near positive off-site feature--park, greenbelt, etc.
RRAe | Adjacent to East-West Railroad
RRAn | Adjacent to North-South Railroad
RRNe | Within 200' of East-West Railroad
RRNn | Within 200' of North-South Railroad
***
> BldgType
***
> tipo de vivienda
***
Codigo | Tipo
-------------------- | --------------------
1Fam | Single-family Detached
2fmCon | Two-family Conversion; originally built as one-family dwelling
Duplex | Duplex
TwnhsE | Townhouse End Unit
Twnhs | I Townhouse Inside Unit
***
> HouseStyle
***
> estilo de vivienda
***
Codigo | Tipo
-------------------- | --------------------
1.5Fin | One and one-half story: 2nd level finished
1.5Unf | One and one-half story: 2nd level unfinished
1Story | One story
2.5Fin | Two and one-half story: 2nd level finished
2.5Unf | Two and one-half story: 2nd level unfinished
2Story | Two story
SFoyer | Split Foyer
SLvl | Split Level
***
> RoofStyle
***
> tipo de techo
***
Codigo | Tipo
-------------------- | --------------------
Flat | Flat
Gable | Gable
Gambrel | Gabrel (Barn)
Hip | Hip
Mansard | Mansard
Shed | Shed
***
> RoofMatl
***
> material de techo
***
Codigo | Tipo
-------------------- | --------------------
ClyTile | Clay or Tile
CompShg | Standard (Composite) Shingle
Membran | Membrane
Metal | Metal
Roll | Roll
Tar&Grv | Gravel & Tar
WdShake | Wood Shakes
WdShngl | Wood Shingles
***
### .
> Exterior1st
***
> revestimiento exterior en la casa
***
Codigo | Tipo
-------------------- | --------------------
AsbShng | Asbestos Shingles
AsphShn | Asphalt Shingles
BrkComm | Brick Common
BrkFace | Brick Face
CBlock | Cinder Block
CemntBd | Cement Board
HdBoard | Hard Board
ImStucc | Imitation Stucco
MetalSd | Metal Siding
Other | Other
Plywood | Plywood
PreCast | PreCast
Stone | Stone
Stucco | Stucco
VinylSd | Vinyl Siding
Wd Sdng | Wood Siding
WdShing | Wood Shingles
***
> Exterior2nd
***
> Cubierta exterior en la casa (si hay más de un material)
***
Codigo | Tipo
-------------------- | --------------------
AsbShng | Asbestos Shingles
AsphShn | Asphalt Shingles
Brk Cmn | Brick Common
BrkFace | Brick Face
CBlock | Cinder Block
CmentBd | Cement Board
HdBoard | Hard Board
ImStucc | Imitation Stucco
MetalSd | Metal Siding
Other | Other
Plywood | Plywood
PreCast | PreCast
Stone | Stone
Stucco | Stucco
VinylSd | Vinyl Siding
Wd Sdng | Wood Siding
Wd Shng | Wood Shingles
***
> MasVnrType
***
> Tipo de chapa de mampostería
***
Codigo | Tipo
-------------------- | --------------------
BrkCmn | Brick Common
BrkFace | Brick Face
Cblock | Cinder Block
None | None
Stone | Stone
***
> ExterQual
***
> calidad del material exterior
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
TA | Average/Typical
Po | Poor
***
> ExterCond
***
> estado actual del material en el exterior
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
Po | Poor
TA | Average/Typical
***
> Foundation
***
> tipo de fundación
***
Codigo | Tipo
-------------------- | --------------------
BrkTil | Brick & Tile
CBlock | Cinder Block
PConc | Poured Contrete
Slab | Slab
Stone | Stone
Wood | Wood
***
> BsmtQual
***
> Altura del sótano
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent (100+ inches)
Fa | Fair (70-79 inches)
Gd | Good (90-99 inches)
**NA** | No Basement
Po | Poor (<70 inches
TA | Typical (80-89 inches)
***
> BsmtCond
***
> estado general del sótano
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair - dampness or some cracking or settling
Gd | Good
**NA** | No Basement
Po | Poor - Severe cracking, settling, or wetness
TA | Typical - slight dampness allowed
***
> BsmtExposure
***
> muros de sotano a ras de suelo o de jardín
***
Codigo | Tipo
-------------------- | --------------------
Av | Average Exposure (split levels or foyers typically score average or above)
Gd | Good Exposure
Mn | Mimimum Exposure
**NA** | No Basement
No | No Exposure
***
> BsmtFinType1
***
> Calidad del área acabada del sótano
***
Codigo | Tipo
-------------------- | --------------------
ALQ | Average Living Quarters
BLQ | Below Average Living Quarters
GLQ | Good Living Quarters
LwQ | Low Quality
**NA** | No Basement
Rec | Average Rec Room
Unf | Unfinshed
***
> BsmtFinType2
***
> Calidad del segundo área terminada (si está presente)
***
Codigo | Tipo
-------------------- | --------------------
ALQ | Average Living Quarters
BLQ | Below Average Living Quarters
GLQ | Good Living Quarters
LwQ | Low Quality
**NA** | No Basement
Rec | Average Rec Room
Unf | Unfinshed
### .
> Heating
***
> tipo de calefacción
***
Codigo | Tipo
-------------------- | --------------------
Floor | Floor Furnace
GasA | Gas forced warm air furnace
GasW | Gas hot water or steam heat
Grav | Gravity furnace
OthW | Hot water or steam heat other than gas
Wall | Wall furnace
***
> HeatingQC
***
> Calidad y condición de la calefacción
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
Po | Poor
TA | Average/Typical
***
> CentralAir
***
> Aire acondicionado central
***
Codigo | Tipo
-------------------- | --------------------
N | No
Y | Yes
***
> Electrical
***
> sistema eléctrico
***
Codigo | Tipo
-------------------- | --------------------
FuseA | Fuse Box over 60 AMP and all Romex wiring (Average)
FuseF | 60 AMP Fuse Box and mostly Romex wiring (Fair)
FuseP | 60 AMP Fuse Box and mostly knob & tube wiring (poor)
Mix | Mixed
SBrkr | Standard Circuit Breakers & Romex
***
> KitchenQual
***
> calidad de la cocina
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
Po | Poor
TA | Typical/Average
***
> Functional
***
> calificación de la funcionalidad del hogar
***
Codigo | Tipo
-------------------- | --------------------
Maj1 | Major Deductions 1
Maj2 | Major Deductions 2
Min1 | Minor Deductions 1
Min2 | Minor Deductions 2
Mod | Moderate Deductions
Sal | Salvage only
Sev | Severely Damaged
Typ | Typical Functionality
***
> FireplaceQu
***
> calidad de la chimenea
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent - Exceptional Masonry Fireplace
Fa | Fair - Prefabricated Fireplace in basement
Gd | Good - Masonry Fireplace in main level
**NA** | No Fireplace
Po | Poor - Ben Franklin Stove
TA | Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement
***
> GarageType
***
> ubicación del garaje
***
Codigo | Tipo
-------------------- | --------------------
2Types | More than one type of garage
Attchd | Attached to home
Basment | Basement Garage
BuiltIn | Built-In (Garage part of house - typically has room above garage)
CarPort | Car Port
Detchd | Detached from home
**NA** | No Garage
***
> GarageFinish
***
> acabado interior del garaje
***
Codigo | Tipo
-------------------- | --------------------
Fin | Finished
RFn | Rough Finished
Unf | Unfinished
**NA** | No Garage
***
> GarageQual
***
> calidad de garaje
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
**NA** | No Garage
Po | Poor
TA | Typical/Average
***
> GarageCond
***
> condición de garaje
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
**NA** | No Garage
Po | Poor
TA | Typical/Average
***
> PavedDrive
***
> calzada pavimentada
***
Codigo | Tipo
-------------------- | --------------------
N | Dirt/Gravel
P | Partial Pavement
Y | Paved
***
> PoolQC
***
> calidad de la piscina
***
Codigo | Tipo
-------------------- | --------------------
Ex | Excellent
Fa | Fair
Gd | Good
**NA** | No Pool
TA | Average/Typical
***
> Fence
***
> calidad de la cerca
***
Codigo | Tipo
-------------------- | --------------------
GdPrv | Good Privacy
GdWo | Good Wood
MnPrv | Minimum Privacy
MnWw | Minimum Wood/Wire
**NA** | No Fence
***
> MiscFeature
***
> característica miscelánea no cubierta en otras categorías
***
Codigo | Tipo
-------------------- | --------------------
Elev | Elevator
Gar2 | 2nd Garage (if not described in garage section)
**NA** | None
Othr | Other
Shed | Shed (over 100 SF)
TenC | Tennis Court
***
> SaleType
***
> Tipo de venta
***
Codigo | Tipo
-------------------- | --------------------
COD | Court Officer Deed/Estate
Con | Contract 15% Down payment regular terms
ConLD | Contract Low Down
ConLI | Contract Low Interest
ConLw | Contract Low Down payment and low interest
CWD | Warranty Deed - Cash
New | Home just constructed and sold
Oth | Other
VWD | Warranty Deed - VA Loan
WD | Warranty Deed - Conventional
***
> SaleCondition
***
> Condiciones de venta
***
Codigo | Tipo
-------------------- | --------------------
Abnorml | Abnormal Sale - trade, foreclosure, short sale
AdjLand | Adjoining Land Purchase
Alloca | Allocation - two linked properties with separate deeds, typically condo with a garage unit
Family | Sale between family members
Normal | Normal Sale
Partial | Home was not completed when last assessed (associated with New Homes)
CUANTIFICADAS {data-orientation=rows .hidden}
=======
Row {data-height=80}
---------------
### VARIABLES CATEGORICAS YA CUANTIFICADAS Y/O ORDINALES {data-width=300}
Estas tienen la peculiaridad de que tienen asignada una numeración aunque realmente son categóricas
### ESTE TIPO DE VARIABLES SON CUANTIFICADAS / ORDINALES . PINCHE EL TIPO AL QUE QUIERE DIRIGIRSE
* Variables [cuantificables](#variables)
* Variables [categoricas](#categoricas) .
* Variables [cuantificadas](#cuantificadas)
Row {data-height=300}
--------------
### .
> MSSubClass
***
> la clase de construcción
***
Codigo | Tipo
-------------------- | --------------------
20 | 1-STORY 1946 & NEWER ALL STYLES
30 | 1-STORY 1945 & OLDER
40 | 1-STORY W/FINISHED ATTIC ALL AGES
45 | 1-1/2 STORY - UNFINISHED ALL AGES
50 | 1-1/2 STORY FINISHED ALL AGES
60 | 2-STORY 1946 & NEWER
70 | 2-STORY 1945 & OLDER
75 | 2-1/2 STORY ALL AGES
80 | SPLIT OR MULTI-LEVEL
85 | SPLIT FOYER
90 | DUPLEX - ALL STYLES AND AGES
120 | 1-STORY PUD (Planned Unit Development) - 1946 & NEWER
150 | 1-1/2 STORY PUD - ALL AGES
160 | 2-STORY PUD - 1946 & NEWER
180 | PUD - MULTILEVEL - INCL SPLIT LEV/FOYER
190 | 2 FAMILY CONVERSION - ALL STYLES AND AGES
### .
> OverallQual
***
> material general y calidad de acabado
***
Codigo | Tipo
-------------------- | --------------------
10 | Very Excellent
9 | Excellent
8 | Very Good
7 | Good
6 | Above Average
5 | Average
4 | Below Average
3 | Fair
2 | Poor
1 | Very Poor
> OverallCond
***
> calificación de la condición general
***
Codigo | Tipo
-------------------- | --------------------
10 | Very Excellent
9 | Excellent
8 | Very Good
7 | Good
6 | Above Average
5 | Average
4 | Below Average
3 | Fair
2 | Poor
1 | Very Poor
3 VALORES NULOS Y PERDIDOS {vertical_layout=scroll data-navmenu="1 PREPARACION"}
========
Column {data-width=250}
-----------------------------------
Veamos primero cuantos valores y en cuantas columnas tenemos **NA**
```{r}
columnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Column {data-width=350}
-----------------------------------
Veamos un listado de los valores **NA** usados como categoria
Estaban marcados en rojo en su respectiva tabla
> **Alley** tipo de acceso a callejones
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No alley access
> **BsmtQual** Altura del sótano
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Basement
> **BsmtCond** estado general del sótano
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Basement
> **BsmtExposure** muros de sotano a ras de suelo o de jardín
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Basement
> **BsmtFinType1** Calidad del área acabada del sótano
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Basement
> **BsmtFinType2** Calidad del segundo área terminada (si está presente)
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Basement
> **FireplaceQu** calidad de la chimenea
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Fireplace
> **GarageType** ubicación del garaje
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Garage
> **GarageFinish** acabado interior del garaje
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Garage
> **GarageQual** calidad de garaje
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Garage
> **GarageCond** condición de garaje
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Garage
> **PoolQC** calidad de la piscina
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Pool
> **Fence** calidad de la cerca
>
Codigo | Significado
--------------|---------------------------------------------------
NA | No Fence
> **MiscFeature** característica miscelánea no cubierta en otras categorías
>
Codigo | Significado
--------------|---------------------------------------------------
NA | None
Column {data-width=300}
-----------------------------------
Podemos apreciar que en todas las variables donde aparece (Callejon, Sotanos, Garages, Piscinas, Cerca y Varios), el sentido que se le da es "Ninguno" o "No existe".
**Por lo que podemos cambiar el código en esas variables por** `NONE`
```{r}
#Cambio los NA por NONE en cada variable
total$Alley[is.na(total$Alley)]<-'NONE'
total$BsmtQual[is.na(total$BsmtQual)]<-'NONE'
total$BsmtCond[is.na(total$BsmtCond)]<-'NONE'
total$BsmtExposure[is.na(total$BsmtExposure)]<-'NONE'
total$BsmtFinType1[is.na(total$BsmtFinType1)]<-'NONE'
total$BsmtFinType2[is.na(total$BsmtFinType2)]<-'NONE'
total$FireplaceQu[is.na(total$FireplaceQu)]<-'NONE'
total$GarageType[is.na(total$GarageType)]<-'NONE'
total$GarageFinish[is.na(total$GarageFinish)]<-'NONE'
total$GarageQual[is.na(total$GarageQual)]<-'NONE'
total$GarageCond[is.na(total$GarageCond)]<-'NONE'
total$PoolQC[is.na(total$PoolQC)]<-'NONE'
total$Fence[is.na(total$Fence)]<-'NONE'
total$MiscFeature[is.na(total$MiscFeature)]<-'NONE'
```
Volvemos a comprobar cuantas columnas quedan con valores **NA** despues de la sustitucion
```{r}
columnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_right')
```
4 BUSQUEDA DETALLADA POR VARIABLES {data-orientation=rows data-navmenu="1 PREPARACION"}
========
Row {data-height=50}
------------
NOS QUEDAN VALORES NULOS POR CONCRETAR EN:
Row {data-height=600 vertical_layout=fill}
-----------
### **PINCHE EN CADA VARIABLE PARA VER EN DETALLE** . {data-width=600}
[GARAGE](#garage)
GarageYrBlt --> 159 registros GarageCars --> 1 registros GarageArea --> 1 registros
[SOTANO(BASEMENT)](#sotano)
BsmtFullBath --> 2 registros BsmtHalfBath --> 2 registros BsmtFinSF1 --> 1 registro BsmtFinSF2 --> 1 registro BsmtUnfSF --> 1 registro TotalBsmtSF --> 1 registro
[MAMPOSTERIA (MasVnr)](#mamposteria)
MasVnrType --> 24 registros MaVnrArea --> 23 registros
[PROPIEDAD (Lot)](#propiedad)
LotFrontage --> 486 registros
[EXTERIOR](#exterior)
Exterior1st --> 1 registro Exterior2nd --> 1 registro
### **PINCHE EN CADA VARIABLE PARA VER EN DETALLE** .
[UTILIDADES (Utilities)](#utilidades)
Utilities --> 2 registros
[FUNCIONAL (Functional)](#funcional)
Functional --> 2 registros
[ELECTRICO (Electrical)](#electrico)
Electrical --> 1 registro
[COCINA (Kitchen)](#cocina)
KitchenQual --> 1 registro
[VENTA (Sale)](#venta)
SaleType --> 1 registro
[ZONIFICACION](#zonificacion)
MSZoning --> 4 registro
[CONCLUSION](#conclusion)
GARAGE{data-orientation=rows .hidden }
=========
GarageYrBlt --> 159 registros GarageCars --> 1 registros GarageArea --> 1 registros
Vamos a ver con que valores de `GarageType` se correponden los **NA** de `GarageYrBlt`
```{r collapse=TRUE}
prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType)
prueba[,2]<-as.factor(prueba[,2])
levels(prueba[,2])
```
Seleccionamos especificamente los registros que no tienen garaje con `NONE`
Ponemos a 0 el año en aquellos que no tienen garage
```{r echo=TRUE}
prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%filter(GarageType=='NONE')%>%select(Id,GarageType)
total[prueba[,1],60]<-0
```
Vemos los registros que nos han quedado con `Detach`
```{r collapse=TRUE}
prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond)
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
**REGISTRO 2577**
Parece claro que el registro 2577 no tiene garage. Ponemos `GarageType`como `NONE` y `GarageYrBlt`,`GarageCars`y `GarageArea`a 0
```{r echo=TRUE}
total[2577,59]<-'NONE'
total[2577,60]<-0
total[2577,62]<-0
total[2577,63]<-0
```
**REGISTRO 2127**
Buscamos registros con `GarageType` y `GarageCars` iguales al registro 2127 y seleccionamos los mas usados
```{r collapse=TRUE}
prueba2<-total%>%filter(GarageType=="Detchd"&GarageCars==1)%>%select(Id,YearBuilt,YearRemodAdd,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond)
freq<-as.data.frame(table(prueba2$GarageFinish,prueba2$GarageQual,prueba2$GarageCond))
colnames(freq)<-c('GarageFinish','GarageQual','GarageCond','Cantidad')
kable(head(freq[order(freq$Cantidad,decreasing = TRUE),]))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Asignamos
```{r echo=TRUE}
total[2127,61]<-"Unf"
total[2127,64]<-"TA"
total[2127,65]<-"TA"
```
Miramos el valor superior entre `YearBuilt` y `YearRemodAdd`
```{r}
kable(total%>%filter(Id==2127)%>%select(YearBuilt,YearRemodAdd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
lo asignamos a `GarageYrBlt`
```{r echo=TRUE}
total[2127,60]<-1983
```
SOTANO{data-orientation=rows .hidden }
===========
BsmtFullBath --> 2 registros BsmtHalfBath --> 2 registros BsmtFinSF1 --> 1 registro BsmtFinSF2 --> 1 registro BsmtUnfSF --> 1 registro TotalBsmtSF --> 1 registro
Row {data-height=1500 .tabset}
-----
### BUSQUEDA **NA**'s
Vemos los registros
```{r collapse=TRUE}
prueba<-total%>%filter(is.na(BsmtFullBath)|is.na(BsmtHalfBath))%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,BsmtFullBath,BsmtHalfBath,TotalBsmtSF)
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Evidentemente ninguno de estos dos registros tiene sotano por lo que los registros que están con NA hay que ponerlos a 0
```{r echo=TRUE}
total[2121,35]<-0
total[2121,37]<-0
total[2121,38]<-0
total[2121,39]<-0
total[2121,48]<-0
total[2121,49]<-0
total[2189,48]<-0
total[2189,49]<-0
```
### CAMPOS DISCORDANTES
Verificamos campos discordantes de sotano que tenga algun campo en `NONE` y otros no
```{r collapse=TRUE}
prueba<-total%>%filter(BsmtCond=='NONE'|BsmtQual=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath)
kable(prueba%>%filter(BsmtCond!='NONE'|BsmtQual!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Procedemos a modificar los campos discordantes por registros similares
### Registro 333
`BsmtFinType2`=`NONE`
Buscamos registros parecidos
Los valores de `BsmtFinType2` son
```{r collapse=TRUE}
prueba1<-total%>%filter(BsmtCond=='TA'& BsmtQual=='Gd'& BsmtExposure=='No'& BsmtFinType1=='GLQ' & BsmtFinType2!='Unf' & BsmtFullBath==1)%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath)
kable(sort(table(prueba1$BsmtFinType2),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(1,background='lawngreen')
```
Asignamos
```{r echo=TRUE}
total[333,36]<-'ALQ'
```
### Registros 949,1488 y 2349
`BsmtExposure`=`NONE`
Estos tres registros coinciden en los campos salvo en BsmtUnSF
Buscamos registros parecidos, comparamos`BsmtExposure`
```{r collapse=TRUE}
prueba1<-total%>%filter( BsmtFinType1=='Unf' & BsmtCond=='TA'& BsmtQual=='Gd' )%>%select(Id,BsmtExposure,BsmtUnfSF,TotalBsmtSF)
kable(table(prueba1$BsmtExposure))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(4,background='lawngreen')
kable(prop.table(table(prueba1$BsmtExposure)))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(4,background='lawngreen')
muro<-ggplot(prueba1,aes(x=BsmtExposure,y=BsmtUnfSF))
muro<-muro+geom_boxplot(varwidth = TRUE)
muro
```
No se aprecia relacion evidente entre el tamaño del sotano y el tipo de muro.
Ademas el campo con mas casos tiene casi un 75%. Lo aplicamos en estos registros
```{r echo=TRUE}
total[949,33]<-'No'
total[1488,33]<-'No'
total[2349,33]<-'No'
```
### Registros 2041,2186 y 2525
`BsmtCond`=`NONE`
No tienen campos en comun. Buscamos por el valor mas representativo de `BsmtCond`
```{r collapse=TRUE}
kable(table(total$BsmtCond))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(5,background='lawngreen')
```
Asignamos el valor `TA`
```{r echo=TRUE}
total[2041,32]<-'TA'
total[2186,32]<-'TA'
total[2525,32]<-'TA'
```
### Registros 2218 y 2219
`BsmtQual`=`NONE`
Registros con campos comunes iguales
```{r collapse=TRUE}
prueba1<-total%>%filter( BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(3,background = 'yellow')%>%row_spec(5,background = 'yellow')
```
Estan repartidos en cantidad en `BsmtQual`. Hay que buscar mas
Filtro por el campo `BsmtCond` que es diferente en cada registro
Para `BsmtCond`=`Fa`
```{r collapse=TRUE}
prueba1<-total%>%filter( BsmtCond=='Fa' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(4,background='lawngreen')
```
Para `BsmtCond`= `TA`
```{r collapse=TRUE}
prueba1<-total%>%filter( BsmtCond=='TA' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')%>%row_spec(5,background='lawngreen')
```
En ambos casos el valor mas usado es `TA`. Lo aplicamos
```{r echo=TRUE}
total[2218,31]<-'TA'
total[2219,31]<-'TA'
```
Row {data-height=50}
--------
MAMPOSTERIA{data-orientation=rows .hidden }
===========
Row {data-height=50}
-------
MasVnrType --> 24 registros MaVnrArea --> 23 registros
Row {data-height=550 vertical_layout=scroll }
-----
### .
Vamos a ver los registros con **NA** relacionados con la albañileria
```{r collapse=TRUE}
prueba<-total%>%filter(is.na(MasVnrType))%>%select(Id,MasVnrType,MasVnrArea)
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
Uno de los elementos a seleccionar en `MasVnrType` es `None`. Ponemos los **NA** como `None` y el area a 0
```{r echo=TRUE}
total$MasVnrArea[is.na(total$MasVnrType)==TRUE]<-0
total$MasVnrType[is.na(total$MasVnrType)==TRUE]<-'None'
```
### .
Compruebo si estan bien todos las areas con un tipo `None`
```{r collapse=TRUE}
prueba<-total%>%filter(MasVnrType=='None' & MasVnrArea>0)%>%select(Id,MasVnrArea)
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Tenemos 7 registros que no tienen el area a 0 y no tienen mamposteria. Se ponen a 0
```{r echo=TRUE}
total$MasVnrArea[total$MasVnrType=='None'& total$MasVnrArea>0]<-0
```
Compruebo si estan bien todos las areas con valor 0 sin tener un tipo `None`
```{r collpase=TRUE}
prueba<-total%>%filter(MasVnrType!='None' & MasVnrArea==0)%>%select(Id,MasVnrType,MasVnrArea)
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Hay tres registros. Como no hay forma de saber el tipo de mamposteria, la ponemos como `NONE`
```{r echo=TRUE}
total[689,26]<-'None'
total[1242,26]<-'None'
total[2320,26]<-'None'
```
Row {data-height=50}
----
PROPIEDAD{.hidden }
===========
LotFrontage --> 486 registros
Tenemos 486 registros con **NA**.
Este es un campo cuantitativo por lo que resultan mas difíciles de definir que los categóricos.
Aquí buscamos en pies la longitud de la propiedad que limita con la calle.
Para poder calcularlo vamos a tener en cuenta que conocemos
* `LotArea` área de la propiedad , que es cuantitativo,
* `LotShape` , que es un factor que indica la configuración de la planta de la propiedad
* `LotConfig` otro factor importante en Real State que indica la forma de la propiedad respecto a su entorno
* `Neighborhood`, que es el entorno donde esta situada
Para obtener un valor que pueda ser comparado vamos a calcular la relación entre la fachada y la raíz cuadrada del área.
La forma que tiene la propiedad puede ser cuadrada, rectangular, trapezoidal, triangular, de forma irregular, etc.
Elegimos la raíz cuadradada del area de un cuadrado, como lado y calculamos la proporción entre ese lado del cuadrado que tendría ese área y la longitud real de la fachada.
Esa medida la vamos a agrupar por el vecindario (`Neighborhood`), la forma de la propiedad (`LotConfig`) y la regularidad de esa forma (`LotShape`)
Recomendado:
https://www.mpac.ca/PropertyTypes/PropertyAssessmentProcedures/ProcedureCalculationEffectiveFrontageDepthandAreaResidentialNonWaterfrontProperties
https://en.wikipedia.org/wiki/Land_lot
http://www.gimme-shelter.com/frontage-50043/
```{r collapse=TRUE, echo=TRUE}
#registros con NA
prueba1<-total%>%filter(is.na(LotFrontage)==TRUE)
options(digits=4)
#resto de registros agrupados
prueba2<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotShape,LotConfig,Neighborhood)
#Calculo proporcion
prueba2[,82]<-prueba2$LotFrontage/sqrt(prueba2$LotArea)
#Numero y media de las proporciones por agrupaciones
prueba3<-prueba2%>%summarise(cuenta=n(),media=mean(V82))
# De cada registro con NA buscamos que agrupacion le corresponde y le asignamos la proporcion que le corresponde de su grupo adecuada a su area propia
for (i in 1:length(prueba1$Id)){
lista<-which((prueba1[i,11]==prueba3$LotConfig)&(prueba1[i,8]==prueba3$LotShape)&(prueba1[i,13]==prueba3$Neighborhood))
prueba1[i,82]<-round(prueba3[lista[1],5]*sqrt(prueba1[i,5]))
}
nrow(table(prueba1%>%filter(is.na(media)==TRUE)))
```
Faltan 40 registros que no estan conformados por los tres campos.
Reducimos las agrupaciones a dos. `LotConfig` y `Neighborhood`
Realizamos las mismas operaciones que en el chunk anterior
```{r collapse=TRUE}
prueba11<-prueba1%>%filter(is.na(media)==TRUE)
prueba22<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotConfig,Neighborhood)
prueba22[,82]<-prueba22$LotFrontage/sqrt(prueba22$LotArea)
prueba23<-prueba22%>%summarise(cuenta=n(),media=mean(V82))
for (i in 1:length(prueba11$Id)){
lista<-which((prueba11[i,11]==prueba23$LotConfig)&(prueba11[i,13]==prueba23$Neighborhood))
prueba11[i,82]<-round(prueba23[lista[1],4]*sqrt(prueba11[i,5]))
}
nrow(table(prueba11%>%filter(is.na(media)==TRUE)))
```
Faltan 4 registros que no estan conformados por los dos campos.
Reducimos a `Neighborhood` y realizamos las misma operaciones
```{r collapse=TRUE}
prueba111<-prueba11%>%filter(is.na(media)==TRUE)
prueba222<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(Neighborhood)
prueba222[,82]<-prueba222$LotFrontage/sqrt(prueba222$LotArea)
prueba223<-prueba222%>%summarise(cuenta=n(),media=mean(V82))
for (i in 1:length(prueba111$Id)){
lista<-which(prueba111[i,13]==prueba223$Neighborhood)
prueba111[i,82]<-round(prueba223[lista[1],3]*sqrt(prueba111[i,5]))
}
nrow(table(prueba111%>%filter(is.na(media)==TRUE)))
```
Ya no quedan registros con **NA** en `media`.
Unimos todos los grupos de registros que hemos hecho.
Reasignamos el valor de `media` a `LotFrontage` y ordenamos el conjunto
```{r}
prueba<-rbind(prueba1[is.na(prueba1$media)==FALSE,],prueba11[is.na(prueba11$media)==FALSE,],prueba111[is.na(prueba111$media)==FALSE,])
prueba$LotFrontage<-prueba$media
total<-rbind(total[is.na(total$LotFrontage)==FALSE,],prueba[,1:81])
#reordenamos
total<-total%>%arrange(Id)
```
EXTERIOR{data-orientation=rows vertical_layout=scroll .hidden }
===========
Exterior1st --> 1 registro Exterior2nd --> 1 registro
Tenemos dos variables categóricas con 1 **NA** cada una en el mismo registro.
```{r collapse=TRUE}
kable(total%>%filter(is.na(Exterior1st)==TRUE)%>%select(Id,Exterior1st,Exterior2nd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Vemos la distribucion
Row { data-height=750 vertical_layout=scroll}
-------
### .
```{r}
kable(sort(table(total$Exterior1st),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
### .
```{r}
kable(sort(table(total$Exterior2nd),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Row {data-height=50 vertical_layout=scroll}
------
Sin mas información escogemos lo mas frecuente
Column {data-height=100}
---------
```{r echo=TRUE}
total[2152,24]<-'VinylSD'
total[2152,25]<-'VinylSD'
```
Row {data-height=50}
------
UTILIDADES{data-orientation=rows .hidden }
===========
Utilities --> 2 registros
Tenemos 2 registros con **NA** en este campo
Vemos como estan distribuidos
Row {data-height=1000 }
------
### .
```{r collapse=TRUE}
kable(total%>%filter(is.na(Utilities)==TRUE)%>%select(Id,Utilities))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
### .
```{r collapse=TRUE}
kable(sort(table(total$Utilities),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Row {dat-height=100}
----
Como parece evidente ponemos estos dos registros como la inmensa mayoría.
Aunque tenerlos casi todos iguales no servirá para predecir nada
Column{dat-height=100}
------
```{r echo=TRUE}
total[1916,10]<-'AllPub'
total[1946,10]<-'AllPub'
```
Row{data-height=50}
----
FUNCIONAL{data-orientation=rows .hidden }
===========
Functional --> 2 registros
Tenemos 2 registros con **NA** en este campo. Vemos como esta distribuido
Row {data-height=1700}
----
### .
```{r collapse=TRUE}
kable(total%>%filter(is.na(Functional)==TRUE)%>%select(Id,Functional))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
### .
```{r}
kable(sort(table(total$Functional),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Row{dat-height=100}
----
Ponemos estos registros como `Typical` que son la mayoría. No tenemos información para mas
Column{dat-height=100}
----
```{r echo=TRUE}
total[2217,56]<-'Typ'
total[2474,56]<-'Typ'
```
Row{data-height=50}
------
ELECTRICO{.hidden }
===========
Electrical --> 1 registro
Tenemos 1 registro con **NA** en este campo
```{r collapse=TRUE}
kable(total%>%filter(is.na(Electrical)==TRUE)%>%select(Id,Electrical))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
kable(sort(table(total$Electrical),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Ponemos este registro como la mayoría, el estándar
```{r echo=TRUE}
total[1380,43]<-'SBrkr'
```
COCINA{data-orientation=rows .hidden }
===========
Row {data-height=80}
----
KitchenQual --> 1 registro
Row {data-height=1500}
-----
### .
Tenemos 1 registro con **NA**
```{r collapse=TRUE}
kable(total%>%filter(is.na(KitchenQual)==TRUE)%>%select(Id,KitchenQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
kable(sort(table(total$KitchenQual),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho
```{r echo=TRUE}
total[1556,54]<-'TA'
```
### .
Por otro lado tenemos tres registros con un numero de cocinas por encima del suelo igual a 0, pero sin embargo su calidad es `Typical`
```{r collapse=TRUE}
kable(total%>%filter(KitchenAbvGr==0)%>%select(Id,KitchenAbvGr,KitchenQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
En principio no es paradójico puesto que no existe la opción de `NONE` en `KitchenQual`
Row {data-height=50}
-------
VENTA{.hidden }
===========
SaleType --> 1 registro
Tenemos 1 registro con **NA** en el campo `SaleType`
```{r collapse=TRUE}
kable(total%>%filter(is.na(SaleType)==TRUE)%>%select(Id))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
kable(sort(table(total$SaleType),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho
```{r echo=TRUE}
total[2490,79]<-'WD'
```
ZONIFICACION{data-orientation=rows .hidden }
===========
MSZoning --> 4 registro
Row {.tabset }
--------
### NUMERO **NA**'s
Tenemos 4 registros con **NA**
```{r collapse=TRUE}
kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),full_width =F,font_size=12,position = 'float_left')
```
### OBSERVACIONES
Estas son el numero de observaciones
```{r collapse=TRUE}
kable(sort(table(total$MSZoning),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
### GRAFICO
En este caso vamos a ver la relación entre:
* el tipo de zonificación `MSZoning`
* el barrio `Neighborhood`
```{r collapse=TRUE}
plotPru<-ggplot(data=total,aes(x=total$Neighborhood,y=total$MSZoning))
plotPru<-plotPru+geom_count()+labs(x="BARRIOS",y="ZONIFICACION")
plotPru<-plotPru+theme(axis.text.x = element_text(angle = 90,hjust=1,vjust=0.5),title = element_text(color="blue",size=12,lineheight = 1))
plotPru
```
### BUSQUEDA **NA**
Compruebo los registros con **NA**
```{r collape=TRUE}
kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id,MSZoning,Neighborhood))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
### BARRIO IDOTRR
Vuelvo a comprobar separando los barrios.
Para los registros del barrio de `IDOTRR`donde tenemos tres registros no existe ninguna vivienda zonificada como `RL` que es la mayoritaria en el conjunto de Ames.
```{r collapse=TRUE}
prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='IDOTRR')
kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Escojo como valor mayoritario `RM`
```{r echo=TRUE}
total[1916,3]<-'RM'
total[2217,3]<-'RM'
total[2251,3]<-'RM'
```
### BARRIO Mitchel
En el barrio de `Mitchel` , donde esta el otro registro, sí es `RL` la mayoritaria
```{r collapse=TRUE}
prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='Mitchel')
kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Escojo como valor mas usado `RL`
```{r echo=TRUE}
total[2905,3]<-'RL'
```
Row {data-height=50}
-----
CONCLUSION{.hidden }
===========
Comprobamos cuantos valores nos quedan con **NA**
```{r collapse=TRUE}
#Comprobamos cuantos NA nos quedan
ColumnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[ColumnasNA], is.na)), decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Que es la variable objetivo
5. CONTRADICCIONES {data-orientation=rows data-navmenu="1 PREPARACION"}
===========
**Vamos a buscar contradicciones entre características similares**
Row {.tabset}
---------
### PISCINA (Pool) {vertical_layout=TRUE}
No se puede establecer una relacion directa entre la calidad de la piscina y el area.
Buscaremos en la calidad general de la casa
```{r collapse=TRUE}
kable(total%>%filter(PoolArea>0 & PoolQC=='NONE')%>%select(Id,PoolQC,PoolArea))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Tenemos tres registros que tienen un area de piscina sin tenerla
Vemos como están distribuidas las piscinas
```{r collapse=TRUE}
kable(sort(table(total$PoolQC),decreasing = TRUE))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
La gran mayoría de las casas no tienen piscina.
De esas 10 que si tienen mas las tres que nos faltan hay que poder encontrar un criterio con el que dar una cualificación a los registros que faltan.
Buscaremos algún tipo de relación
```{r collapse=TRUE}
prueba<-total%>%filter(PoolArea>0 )%>%select(Id,PoolQC,PoolArea,OverallQual,OverallCond)
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$OverallQual))
plotPru2<-plotPru2+geom_boxplot()
plotPru2
plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$PoolArea))
plotPru2<-plotPru2+geom_boxplot()
plotPru2
```
Parece que existe cierta relacion entre la calidad general y el area de piscina
Vamos a verlo numericamente .
Llamo `razon` a la proporcion `OverallQual`*100/`PoolArea`
```{r collapse=TRUE}
options(digits = 3)
prueba$razon<-(prueba$OverallQual*100)/prueba$PoolArea
#Ordenamos
prueba<-prueba%>%arrange(desc(prueba$razon))
kable(prueba)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'float_left')
```
Si se puede establecer una cierta relación , por lo que asignamos la calidad de la piscina asi, teniendo en cuenta que good `Gd` es mejor que fair `Fa`
```{r echo=TRUE}
total[2504,73]<-'Gd'
total[2421,73]<-'Gd'
total[2600,73]<-'Fa'
```
### CHIMENEA (Fireplace)
No existe contradiccion entre el numero de chimeneas y la calidad
```{r collapse=TRUE, echo=TRUE}
nrow(total%>%filter(Fireplaces>0 & FireplaceQu=='NONE')%>%select(Id,Fireplaces,FireplaceQu,OverallQual,OverallCond))
```
### SOTANO (Basement)
En las areas tenemos que el area del tipo 1 + area del tipo 2 + area sin terminar = Area total
Comprobamos y buscamos incongruencias
```{r collapse=TRUE,echo=TRUE}
prueba<-total%>%select(Id,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
prueba[,2]<--prueba[,2]
prueba[,6]<-apply(prueba[,2:5],1,sum)
nrow(prueba%>%filter(V6>0))
```
No existe ningun registro con el area mal
En los registros sin sotano compruebo que no exista algún campo que no corresponda
Existen 79 registros que no tienen sotano
```{r collapse=TRUE,echo=TRUE}
prueba<-total%>%filter(BsmtQual=='NONE'|BsmtCond=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
prueba1<-prueba%>%filter(BsmtQual!='NONE'|BsmtCond!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'|BsmtFullBath>0|BsmtHalfBath>0)%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
nrow(prueba1)
```
Ninguno de ellos tiene incongruencias
Busco los sotanos existentes que no tienen area construida en el primer tipo
```{r echo=TRUE}
prueba<-total%>%filter(BsmtFinType1!='NONE' & BsmtFinSF1==0 )%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
table(prueba$BsmtFinType1,prueba$BsmtFinType2)
```
Esos 851 no tiene tampoco del segundo tipo `Unf`
```{r echo=TRUE}
table(prueba$BsmtFinSF1,prueba$BsmtFinSF2)
```
Las areas son 0 en todos los casos
```{r echo=TRUE}
nrow(prueba%>%filter(prueba$BsmtUnfSF==0))
```
Todos los registros aparecen como `Unf` Inacabado. Es correcto
### GARAGE
En los inmuebles sin garaje buscamos registros que tengan campos con contradicciones o incongruencias
```{r collapse=TRUE,echo=TRUE}
prueba<-total%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE')%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
```
En los inmuebles con garaje buscamos registros que tengan campos con contradicciones o incongruencias
```{r collapse=TRUE,echo=TRUE}
prueba<-total%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE' | GarageYrBlt==0 | GarageCars==0 | GarageArea==0)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
```
6. TIPOLOGIAS{ data-navmenu="1 PREPARACION"}
===========
Column {.tabset}
------------
### **CATEGORICAS**
Teniendo en cuenta que para el análisis con las variable independientes categóricas se crearan variables "dummy", tantas como categorías-1 por cada variable, parece claro pensar que favorece reducir el numero de variables, reduciendo la complejidad.
En nuestro caso , y en mi opinión es posible realizarlo cambiando ciertas variables de categóricas a ordinales.
Sobre todo en aquellas que tengan un orden que parezca lógico.
Para seguir un criterio razonable, he escogido la transformación creciente desde 0 hasta el numero de categorías dentro de cada variable, siempre desde menos a mas, o si se prefiere de peor a mejor, pero con la salvedad de que 0 solo se escoge para la categoría que significa que no existe esa variable.
Por simplificar con un ejemplo, puedo tener una variable que me habla de la calidad del acabado del garaje, dentro de las cuales tengo varias categorías que van desde una mala calidad a una muy buena.
Evidentemente el orden es creciente con el máximo valor para la mejor de las categorías, pero el 0 se reserva solo si dentro de esas categorías me aparece una indicando que no tiene garaje
Estas son las variables categóricas que he seleccionado, y al lado la asignación que le doy a cada categoría de cada una de ellas
[VER](#tipocategoricas)
### **ORDINALES**
Vamos a revisar las variables que ya teníamos como ordinales en los datos originales
Mientras que `OverallQual` y `OverallCond` no ofrecen ninguna duda, `MSSubclass` me parece que no esta correctamente planteada.
Puede que se usara ese código numerico para identificar mejor las distintas clases de edificación pero no tiene una relación ordinal
Se puede apreciar en el grafico con la relación que tiene con el precio
[VER](#tipoordinales)
### **CUANTITATIVAS**
En el caso de variables cuantitativas originalmente en el dataset , vamos a revisar aquellas que no tengan justificación como numericas
Antes de empezar voy a revisar la normalidad de las variables cuantitativas para lo cual he creado un pequeño codigo que me indica la normalidad `SI` o `NO` de las variables
```{r}
#Columnas con valores numericos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Preparar datos
options(digits=18)
normal<-data.frame()
for (i in 1:length(TrainNum)){
normal[i,1]<-colnames(TrainNum[i])
normal[i,2]<-shapiro.test(TrainNum[,i])[[2]]
if (normal[i,2]<0.05) {
normal[i,3]<-'NO'
}else {
normal[i,3]<-'SI'
}
}
colnames(normal)<-c('Variable','p-value')
#Numero de variables normales(SI o NO)
table(normal[,3])
```
El resultado es que ninguna de las variables numéricas tienen normalidad. Esto me sirve para seleccionar el método de correlacion de Spearman
Vemos las variables cuantitativas susceptibles de cambiarse a categoricas
En principio voy a revisar aquellas cuya cantidad represente algo en si misma, y en esta categoría entran todo lo referido a fechas. Repasando una por una
En la categoria de fechas se encuentran las 4 primeras
[MOSOLD (Mes venta)](#mosold)
[YRSOLD (Año venta)](#yrsold)
[YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)](#yearbuilt-yearremodadd)
[GarageYrBuilt (Año en el que fue construido el garage)](#garageyrbuilt)
Veremos a continuacion el resto de variables cuantitativas y relación entre ellas para poder ver si reducimos su numero.
Voy a crear una matriz de correlaciones entre estas variables sin contar en principio con el precio.
Para saber si existe una dependencia entre algunas de ellas que nos pueda servir.
Para eso uso el paquete `corrplot`
Esta es la revision general
[REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)](#revision-resto-cuantitativas)
Vere a continuación las variables con una fuerte correlacion por si se puede reducir el numero de variables predictoras
[ANTIGUEDAD y ANTGARAGE](#antiguedad-y-antgarage)
[GARAGECARS Y GARAGEAREA](#garagecars-y-garagearea)
[FIREPLACES y FIREPLACEQU](#fireplaces-y-fireplacequ)
[1STFlRSF y TOTALBSMTSF](#stflrsf-y-totalbsmtsf)
[GRLIVAREA FULLBATH TOTRMSABVGRD](#grlivarea-fullbath-totrmsabvgrd)
[Normalizacion de resto de variables](#normalizacion-de-resto-de-variables)
[CONCLUSION](#conclusion-1)
Todos estos epigrafes se encuentran ademas en el menu **`2 PREPARACION`**
### **FACTORES**
En el caso del estudio de las variables categóricas, tenemos que partir de un enfoque diferente
Como estamos hablando de variables categóricas no podemos en principio calcular un valor directo como usábamos el de la correlacion en las variables continuas.
Pero si podemos usar el coeficiente de determinación o bondad del ajuste que en los casos de regresion lineal simple es el cuadrado de la correlacion de Pearson.
Luego la forma de seleccionar aquellas variables que tienen influencia sobre el precio va a ser calcular el coeficiente de determinación
Para facilitar esto vamos a usar el paquete `FactoMineR`.
Esta todo detallado en el menu **`3 PREPARACION`**
TIPOCATEGORICAS {data-orientation=rows .hidden}
=======
Row
---------------
### [VOLVER A TIPOLOGIAS](#tipologias)
> LotShape
***
> forma general de la propiedad
***
Codigo | Tipo
-------------------- | --------------------
Reg **4** | Regular
IR1 **3** | Slightly irregular
IR2 **2** | Moderately Irregular
IR3 **1** | Irregular
> LandSlope
***
> Pendiente de la propiedad
***
Codigo | Tipo
-------------------- | --------------------
Gtl **3** | Gentle slope
Mod **2** | Moderate Slope
Sev **1** | Severe Slope
> ExterQual
***
> calidad del material exterior
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Average/Typical
Fa **2** | Fair
Po **1** | Poor
> ExterCond
***
> estado actual del material en el exterior
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Average/Typical
Fa **2** | Fair
Po **1** | Poor
> BsmtQual
***
> Altura del sótano
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent (100+ inches)
Gd **4** | Good (90-99 inches)
TA **3** | Typical (80-89 inches)
Fa **2** | Fair (70-79 inches)
Po **1** | Poor (<70 inches
NONE **0** | No Basement
> BsmtCond
***
> estado general del sótano
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Typical - slight dampness allowed
Fa **2** | Fair - dampness or some cracking or settling
Po **1** | Poor - Severe cracking, settling, or wetness
NONE **0** | No Basement
> BsmtExposure
***
> muros de sotano a ras de suelo o de jardín
***
Codigo | Tipo
-------------------- | --------------------
Gd **4** | Good Exposure
Av **3** | Average Exposure (split levels or foyers typically score average or above)
Mn **2** | Mimimum Exposure
No **1** | No Exposure
NONE **0** | No Basement
> BsmtFinType1
***
> Calidad del área acabada del sótano
***
Codigo | Tipo
-------------------- | --------------------
GLQ **6** | Good Living Quarters
ALQ **5** | Average Living Quarters
BLQ **4** | Below Average Living Quarters
Rec **3** | Average Rec Room
LwQ **2** | Low Quality
Unf **1** | Unfinshed
NONE **0** | No Basement
### [VOLVER A TIPOLOGIAS](#tipologias)
> BsmtFinType2
***
> Calidad del segundo área terminada (si está presente)
***
Codigo | Tipo
-------------------- | --------------------
GLQ **6** | Good Living Quarters
ALQ **5** | Average Living Quarters
BLQ **4** | Below Average Living Quarters
Rec **3** | Average Rec Room
LwQ **2** | Low Quality
Unf **1** | Unfinshed
NONE **0** | No Basement
> HeatingQC
***
> Calidad y condición de la calefacción
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Average/Typical
Fa **2** | Fair
Po **1** | Poor
> KitchenQual
***
> calidad de la cocina
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Average/Typical
Fa **2** | Fair
Po **1** | Poor
> FireplaceQu
***
> calidad de la chimenea
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent - Exceptional Masonry Fireplace
Gd **4** | Good - Masonry Fireplace in main level
TA **3** | Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement
Fa **2** | Fair - Prefabricated Fireplace in basement
Po **1** | Poor - Ben Franklin Stove
NONE **0** | No Fireplace
> GarageFinish
***
> acabado interior del garaje
***
Codigo | Tipo
-------------------- | --------------------
Fin **3** | Finished
RFn **2** | Rough Finished
Unf **1** | Unfinished
NONE **0** | No Garage
> GarageQual
***
> calidad de garaje
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Average/Typical
Fa **2** | Fair
Po **1** | Poor
NONE **0** | No Garage
> GarageCond
***
> condición de garaje
***
Codigo | Tipo
-------------------- | --------------------
Ex **5** | Excellent
Gd **4** | Good
TA **3** | Average/Typical
Fa **2** | Fair
Po **1** | Poor
NONE **0** | No Garage
> PoolQC
***
> calidad de la piscina
***
Codigo | Tipo
-------------------- | --------------------
Ex **4** | Excellent
Gd **3** | Good
TA **2** | Average/Typical
Fa **1** | Fair
NONE **0** | No Pool
### [VOLVER A TIPOLOGIAS](#tipologias)
```{r echo=TRUE}
#Guardamos los cambios y los vuelvo a abrir para que me convierta los caracteres a factor
write.csv(total,file="Total1.csv",row.names = FALSE)
total<-read.csv("Total1.csv",sep=",",header = TRUE)
```
Las cambiamos
```{r echo=TRUE,message=FALSE,warnings=FALSE}
total$BsmtCond<-plyr::revalue(total$BsmtCond,c('NONE'='0','Po'='1','Fa'='2','TA'='3','Gd'='4','Ex'=5))
total$BsmtExposure<-plyr::revalue(total$BsmtExposure,c('NONE'=0,'No'=1,'Mn'=2,'Av'=3,'Gd'=4))
total$BsmtFinType1<-plyr::revalue(total$BsmtFinType1,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6))
total$BsmtFinType2<-plyr::revalue(total$BsmtFinType2,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6))
total$BsmtQual<-plyr::revalue(total$BsmtQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$ExterCond<-plyr::revalue(total$ExterCond,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$ExterQual<-plyr::revalue(total$ExterQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$FireplaceQu<-plyr::revalue(total$FireplaceQu,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$GarageCond<-plyr::revalue(total$GarageCond,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$GarageFinish<-plyr::revalue(total$GarageFinish,c('NONE'=0,'Unf'=1,'RFn'=2,'Fin'=3))
total$GarageQual<-plyr::revalue(total$GarageQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$HeatingQC<-plyr::revalue(total$HeatingQC,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$KitchenQual<-plyr::revalue(total$KitchenQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$LandSlope<-plyr::revalue(total$LandSlope,c('Sev'=1,'Mod'=2,'Gtl'=3))
total$LotShape<-plyr::revalue(total$LotShape,c('IR3'=1,'IR2'=2,'IR1'=3,'Reg'=4))
total$PoolQC<-plyr::revalue(total$PoolQC,c('NONE'=0,'Fa'=1,'TA'=2,'Gd'=3,'Ex'=4))
total$BsmtCond<-as.numeric(levels(total$BsmtCond))[total$BsmtCond]
total$BsmtExposure<-as.numeric(levels(total$BsmtExposure))[total$BsmtExposure]
total$BsmtFinType1<-as.numeric(levels(total$BsmtFinType1))[total$BsmtFinType1]
total$BsmtFinType2<-as.numeric(levels(total$BsmtFinType2))[total$BsmtFinType2]
total$BsmtQual<-as.numeric(levels(total$BsmtQual))[total$BsmtQual]
total$ExterCond<-as.numeric(levels(total$ExterCond))[total$ExterCond]
total$ExterQual<-as.numeric(levels(total$ExterQual))[total$ExterQual]
total$FireplaceQu<-as.numeric(levels(total$FireplaceQu))[total$FireplaceQu]
total$GarageCond<-as.numeric(levels(total$GarageCond))[total$GarageCond]
total$GarageFinish<-as.numeric(levels(total$GarageFinish))[total$GarageFinish]
total$GarageQual<-as.numeric(levels(total$GarageQual))[total$GarageQual]
total$HeatingQC<-as.numeric(levels(total$HeatingQC))[total$HeatingQC]
total$KitchenQual<-as.numeric(levels(total$KitchenQual))[total$KitchenQual]
total$LandSlope<-as.numeric(levels(total$LandSlope))[total$LandSlope]
total$LotShape<-as.numeric(levels(total$LotShape))[total$LotShape]
total$PoolQC<-as.numeric(levels(total$PoolQC))[total$PoolQC]
```
TIPOORDINALES { .hidden}
=========
Revision de las ordinales originales
Column{data-width=1000}
-------
```{r collapse=TRUE}
Train<-total%>%filter(is.na(SalePrice)==FALSE)
PlotClas<-ggplot()
PlotClas<-PlotClas+geom_col(data=Train,aes(x=Train$MSSubClass,y=Train$SalePrice),fill="lightblue")
PlotClas<-PlotClas+labs(x="Clases",y="Precios")
PlotClas
```
Column {data-width=500}
------
Cambiamos de ordinal a categorica
```{r echo=TRUE}
Cod<-c('20'='1-STORY 1946 & NEWER ALL STYLES','30'='1-STORY 1945 & OLDER','40'='1-STORY W/FINISHED ATTIC ALL AGES','45'='1-1/2 STORY - UNFINISHED ALL AGES','50'='1-1/2 STORY FINISHED ALL AGES','60'='2-STORY 1946 & NEWER','70'='2-STORY 1945 & OLDER','75'='2-1/2 STORY ALL AGES','80'='SPLIT OR MULTI-LEVEL','85'='SPLIT FOYER','90'='DUPLEX - ALL STYLES AND AGES','120'='1-STORY PUD (Planned Unit Development) - 1946 & NEWER','150'='1-1/2 STORY PUD - ALL AGES','160'='2-STORY PUD - 1946 & NEWER','180'='PUD - MULTILEVEL - INCL SPLIT LEV/FOYER','190'='2 FAMILY CONVERSION - ALL STYLES AND AGES')
total$MSSubClass<-as.factor(total$MSSubClass)
total$MSSubClass<-plyr::revalue(total$MSSubClass,Cod)
```
[VOLVER A TIPOLOGIAS](#tipologias)
1. MOSOLD{.storyboard data-navmenu="2 PREPARACION"}
=========
### Vemos como se distribuye
```{r collapse=TRUE}
options(digits=6)
mes1<-ggplot()
mes1<-mes1+geom_bar(data=TotalNum,aes(x=TotalNum$MoSold),fill='blue',position = 'stack')
mes1<-mes1+geom_bar(data=TrainNum,aes(x=TrainNum$MoSold),fill='red',position = 'stack')
mes1<-mes1+labs(x='MESES',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes1
```
***
En azul el total de viviendas, y por encima en rojo solo el conjunto de entrenamiento.
No parece que haya excesivas diferencias y en la mayoría de los meses se aprecia visualmente que el conjunto de entrenamiento representa la mitad del total.
Podemos apreciar que la numeración se refiere evidentemente a los meses y refleja una distribución en la venta superior en los meses de Mayo, Junio y Julio.
### Veamos si eso afecta a el precio de venta en el conjunto Train
```{r collapse=TRUE}
mes<-ggplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice))
mes<-mes+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
mes<-mes+geom_bar(stat="summary",fun.y="mean",fill="royalblue")
mes<-mes+labs(x='MESES',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes<-mes+scale_y_continuous(labels = scales::comma)
mes
```
***
El precio medio es parecido y no se ve relación con el mes (por encima aparece la cantidad)
### Boxplot
```{r collapse=TRUE}
mes2<-ggplot()
mes2<-mes2+geom_boxplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice,group=TrainNum$MoSold))
mes2<-mes2+labs(x='MESES',y='PRECIO ')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes2<-mes2+scale_y_continuous(labels = scales::comma)
mes2
```
### Vemos correlacion
```{r echo=TRUE}
cor(x=TrainNum$MoSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
```
***
En mi opinión con esa correlacion tan próxima a 0 no influye para nada en el precio
2. YRSOLD{.storyboard data-navmenu="2 PREPARACION"}
============
### Tenemos un total de cuatro años. Veamoslo gráficamente al igual que con los meses
```{r collapse=TRUE}
year1<-ggplot()
year1<-year1+geom_bar(data=TotalNum,aes(x=TotalNum$YrSold),fill='blue',position = 'stack')
year1<-year1+geom_bar(data=TrainNum,aes(x=TrainNum$YrSold),fill='red',position = 'stack')
year1<-year1+labs(x='AÑOS',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year1
```
### La media por año con el numero de casos
```{r collapse=TRUE}
year<-ggplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice))
year<-year+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
year<-year+geom_bar(stat="summary",fun.y="mean",fill="royalblue")
year<-year+labs(x='AÑOS',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year<-year+scale_y_continuous(labels = scales::comma)
year
```
### Boxplot
```{r collapse=TRUE}
year2<-ggplot()
year2<-year2+geom_boxplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice,group=TrainNum$YrSold))
year2<-year2+labs(x='AÑOS',y='PRECIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year2<-year2+scale_y_continuous(labels = scales::comma)
year2
```
### Vemos correlacion
```{r echo=TRUE}
cor(x=TrainNum$YrSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
```
***
Tienen una correlacion cercana a 0 lo cual indica una influencia en el precio infima
Tiene la particularidad de que nos puede servir para considerar la antigüedad de la vivienda y ahí puede ser relevante su uso.
Voy a posponerlo para mas adelante cuando veamos el año de construcción y el de remodelación
3. YEARBUILT YEARREMODADD{.storyboard data-navmenu="2 PREPARACION"}
=======
### Vamos a ver gráficamente la relación con el precio de venta del año de construccion
```{r collapse=TRUE}
built<-ggplot()
built<-built+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice),color='blue')
built<-built+labs(x='AÑOS',y='PRECIO',title='CONSTRUCCION')+scale_y_continuous(labels = scales::comma)
built
```
***
Vemos estas dos variables puesto que están muy relacionadas.
El año de construccion no necesita explicación, en cuanto a el año de remodelacion es el año en que la vivienda ha sufrido algún tipo de reforma.
Si no ha tenido ninguna esta se corresponde con la fecha de construcción.
### Vemos ahora para el año de remodelación
```{r collapse=TRUE}
built1<-ggplot()
built1<-built1+geom_point(data=TrainNum,aes(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice),color='red')
built1<-built1+labs(x='AÑOS',y='PRECIO',title= 'REMODELACION')+scale_y_continuous(labels = scales::comma)
built1
```
***
Tiene la peculiaridad de que computa a partir de 1950, y en ese año tiene un numero extraordinario de casos, 178 en el Train y 361 en el total, seguramente porque se empezaría a computar ese año y todas las que tienen una antigüedad mayor se computan aqui
### Parece razonable pensar a la vista de las graficas que existe algún tipo de relación con el precio de venta. Numericamente:
```{r echo=TRUE}
#Correlacion año construccion
cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
#Correlacion año remodelacion
cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
```
***
¿Que pasaria si distinguimos aquellas casas que han sido remodeladas , y por lo tanto su fecha de remodelacion es diferente a la de construccion, de aquellas que no lo han sido?
### Prueba de remodelacion.
Creamos una columna.
No remodelados=0. Remodelados=1
```{r }
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
```
```{r echo=TRUE}
#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
```
***
Esta claro que importa el año de construccion, importa el año de remodelacion, importa si estan o no remodeladas en cuanto afecta a su antigüedad y además tenemos unos valores extraños en 1950 que debemos corregir.
Voy a considerar que ninguna de esas viviendas situadas en 1950 han sido remodeladas por lo que aplicare a esa variable, la del año de construcción
### Aplico a la remodelacion de los de 1950 el año de construccion y recalculamos
```{r}
total$YearRemodAdd[total$YearRemodAdd<1951]<-total$YearBuilt[total$YearRemodAdd<1951]
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Vuelvo a comprobar correlacion
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
```
```{r echo=TRUE}
#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
```
### Graficamente
```{r collapse=TRUE}
built3<-ggplot()
built3<-built3+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,color=Remodelado))
built3<-built3+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none')
built3<-built3+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION VIVIENDAS')+scale_y_continuous(labels = scales::comma)
built3
```
***
Vamos a afinar un poco mas calculando la antigüedad respecto al año de venta. Creamos una columna nueva
### Calculo antiguedad completa y comprobamos posibles errores
```{r collapse=TRUE}
total$Antiguedad<-total$YrSold-total$YearBuilt
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Buscamos errores
kable(TotalNum%>%filter(Antiguedad<0)%>%select(Id,YearBuilt,YrSold))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
```{r echo=TRUE}
total[2550,78]<-2008
```
```{r}
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
***
Existe un registro con el año de venta anterior al de la construccion. Lo igualo
Buscarè errores también en el año de remodelación
### Revision de incongruencia de datos con YearRemodAdd
```{r collapse=TRUE}
kable(TotalNum%>%filter((TotalNum$YrSold-TotalNum$YearRemodAdd)<0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
```{r echo=TRUE}
total[524,21]<-2007
total[2296,21]<-2007
total[2550,21]<-2008
```
***
Corrijo los valores del año de remodelacion posteriores al año de construccion y venta, y pongo los valores de este ultimo
### Mas incongruencias
```{r collapse=TRUE}
kable(TotalNum%>%filter((TotalNum$YearBuilt-TotalNum$YearRemodAdd)>0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
```{r echo=TRUE}
total[1877,21]<-2002
```
***
El año de remodelacion es anterior al de construccion
Corrijo los valores al año de construccion
### Volvemos a calcular y actualizar
```{r}
total$Antiguedad<-total$YrSold-total$YearBuilt
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Vuelvo a comprobar correlacion
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
```
```{r echo=TRUE}
#Calculamos correlacion para remodelados
cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")
#No remodelados
cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")
```
***
Al cambiar el calculo sobre la antiguedad se invierte el signo de la correlacion
### Graficamente la antiguedad
```{r collapse=TRUE}
built4<-ggplot()
built4<-built4+geom_point(data=TrainNum,aes(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,color=Remodelado))
built4<-built4+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none')
built4<-built4+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD VIVIENDAS')+scale_y_continuous(labels = scales::comma)
built4
```
***
Los valores son parecidos pero al calcular sobre el numero de años se invierte el signo
En conclusión, la antigüedad de la vivienda tiene una relación fuerte con el precio de venta, y además el hecho de ser una vivienda remodelada o no tambien es importante.
Le afecta menos cuando se ha realizado dicha remodelación.
### Por lo cual calculamos la antigüedad (ya realizado), calculamos si hay o no remodelación {data-commentary-width=600}
```{r echo=TRUE}
#Conclusiones
total$Remodelado<-0
total$Remodelado[total$YearBuilt!=total$YearRemodAdd]<-1
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
```
***
Si calculamos la correlacion de la antiguedad respecto al precio tenemos un valor **`r cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")`**.
Hemos visto que los remodelados tienen **`r cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")`** y los no remodelados **`r cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")`** lo que significa que están penalizados por el calculo conjunto.
Podriamos pensar que si tomamos la antigüedad como la diferencia entre el año de venta y el de remodelación(teniendo en cuenta que para las viviendas no remodeladas este es igual que el de construcción) obtendríamos una variable mas adecuada, pero es al contrario , el valor de la correlacion es **`r cor(x=(TrainNum$YrSold-TrainNum$YearRemodAdd),y=TrainNum$SalePrice,method="spearman",use="na.or.complete")`**.
Hay que encontrar una manera de penalizar a las viviendas remodeladas en su antigüedad
Mi propuesta es penalizar a las viviendas que han sido remodeladas aumentando su antigüedad de manera artificial.
Proporcionalmente al tiempo que se ha tardado en remodelar. ¿Cuánto?. La decima porcentual que tienen de diferencia las correlaciones.
### Vemos los valores y penalizamos
```{r echo=TRUE}
#Penalizacion
TotalNum.remo<-TotalNum%>%filter(Remodelado==1)
summary(TotalNum.remo$YearRemodAdd-TotalNum.remo$YearBuilt)
```
```{r echo=TRUE}
total$Penaliza<-total$YearRemodAdd-total$YearBuilt
#Normalizo y penalizo
total$Antiguedad<-normalize(total$Antiguedad)
total$Penaliza<-normalize(total$Penaliza)
total$Antiguedad<-total$Antiguedad+total$Penaliza*0.1
#Borro las variables auxiliares Remodelado y Penaliza
total$Remodelado<-NULL
total$Penaliza<-NULL
#Vemos correlacion nueva variable Antiguedad
cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
```
```{r}
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
***
Creo una columna donde pongo este calculo
Como la antiguedad la tenemos en enteros y para ser justo con la penalizacion voy a normalizar las variables
Luego le aplicare un 10% de la antigüedad de la remodelación a la antigüedad de la vivienda
La correlacion de Antiguedad es de **`r cor(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")`**
Partiamos de una correlacion de Año Construccion de **`r cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")`** y en Año Remodelacion de **`r cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")`**
Nos hemos acercado a la mas alta pero reduciendo a la mitad el numero de variables
4. GARAGEYRBUILT {.storyboard data-navmenu="2 PREPARACION"}
====
### Eliminamos los valores igual a 0, o sea que no tienen garaje. Ya comprobamos anteriormente la congruencia de los registros. Vemos gráficamente
```{r}
GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0)
garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt))
garage<-garage+geom_histogram(fill='blue')
garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage
```
***
Tenemos un outlier. Corresponde al registro 2593.
### Vamos a ver los datos pertinentes y modificamos
```{r}
kable(total%>%filter(Id==2593)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars,YearBuilt,YearRemodAdd,YrSold))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
```{r echo=TRUE}
total[2593,60]<-2007
```
***
Podemos inferir que el año real de construcción del garaje es 2007 y no 2207.
### Recalculamos y volvemos a observar
```{r }
#Recalcular
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Visualizacion total
GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0)
garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt))
garage<-garage+geom_histogram(fill='blue')
garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage
```
### Verifico que el año de construcción del Garage sea posterior al de la casa. Ponemos el año como el de la vivienda en los que no lo sea
```{r }
GarageTOTAno$dif<-GarageTOTAno$GarageYrBlt-GarageTOTAno$YearBuilt
kable(GarageTOTAno%>%filter(dif<0)%>%select(Id,YearBuilt,GarageYrBlt))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
```{r echo=TRUE}
total$GarageYrBlt[(total$GarageYrBlt%filter(is.na(SalePrice)==FALSE)
```
***
Hay 18 registros que tienen el año de construccion del garage anterior al de la vivienda. Entiendo que se debe a errores tipográficos, como confundir un 4 por un 9 o diferencias pequeñas de tiempo que hacen variar en un año
### Veamos la relación con el precio
```{r collapse=TRUE}
#Visualizar train. Eliminamos los que no tienen garaje
GarageAno<-TrainNum%>%filter(GarageYrBlt!=0)
garage1<-ggplot()
garage1<-garage1+geom_point(data=GarageAno,aes(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice))
garage1<-garage1+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage1
```
***
Podemos pensar que parece existir una relación.
### Numericamente
```{r echo=TRUE}
cor(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice,method="spearman",use="na.or.complete")
```
***
Hay que tener en cuenta que no he incluido los registros que no tienen garaje.
Si se les incluye, curiosamente la correlacion aumenta.
### De todas formas es interesante realizar como con la variable anterior, calcular la antigüedad
```{r echo=TRUE}
#Calculo antiguedad Garaje
total$AntGarage<-total$YrSold-total$GarageYrBlt
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Correlacion
cor(x=TrainNum$AntGarage,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
```
### Y graficamente
```{r}
garage2<-ggplot()
garage2<-garage2+geom_point(data=TrainNum,aes(x=TrainNum$AntGarage,y=TrainNum$SalePrice))
garage2<-garage2+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage2
```
***
Todo el grupo de observaciones que se ve a la derecha son aquellos que no tienen garage y les sale como antiguedad tanta como el año de venta. Eso les supone una penalizacion
**En conclusion para las variables `YearBuilt`, `YearRemodAdd`, `MoSold`, `YrSold` y `GarageYrBlt` nos quedamos con `Antigüedad` y `AntGarage` como variables importantes para el precio de venta**
5. REVISION RESTO CUANTITATIVAS {.storyboard data-navmenu="2 PREPARACION"}
==========
### Primero la correlacion de las variables entre si, sin contar con el precio ni las variables ya tratadas {vertical_layou=scroll}
```{r collapse=TRUE}
TotalNum.noprice<-TotalNum%>%select(-Id,-SalePrice,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt )
#Matriz correlaciones
CorrNum<-cor(TotalNum.noprice,method = 'spearman')
#Valores absolutos
CorrNum.abs<-as.data.frame(abs(CorrNum))
#Pongo a 0 los 1 para encontrar el maximo
CorrNum.abs[which(CorrNum.abs==1,arr.ind = TRUE)]<-0
#Busco el valor maximo de correlacion en cada variable ahora
CorrNum.inf<-apply(CorrNum.abs,2,max)
#Elimino las filas y columnas con correlacion baja
CorrNum.max<-CorrNum.abs[-(which(CorrNum.inf<0.5)),-(which(CorrNum.inf<0.5))]
#Pongo a 0 los valores inferiores a 0.5
CorrNum.max[which(CorrNum.max<0.5,arr.ind = TRUE)]<-0
CorrNum.max<-as.matrix(CorrNum.max)
corrplot(CorrNum.max,order = 'hclust',hclust.method = 'ward.D2',sig.level = 0.5,tl.col = 'black',tl.cex = 0.8,tl.srt = 45,addrect = 14,diag = FALSE)
```
***
Se ve claramente dependencia en ciertos grupos de variables.
### Antes de seguir vamos a ver la correlacion de las variable significativas (superior a 0.5 en términos absolutos) respecto al Precio
```{r collapse=TRUE}
#CORRELACION CON PRECIO
TrainNum.price<-TrainNum%>%select(-Id,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt )
#Matriz correlaciones
CorrPri<-cor(TrainNum.price,method = 'spearman')
CorrPri.abs<-as.data.frame(CorrPri)
#Pongo a 0 los 1 para encontrar el maximo
CorrPri.abs[which(CorrPri.abs==1,arr.ind = TRUE)]<-0
#Busco el valor maximo de correlacion en cada variable ahora
CorrPri.inf<-apply(CorrPri.abs,2,max)
#Busco el valor minimo de correlacion en cada variable ahora
CorrPri.sup<-apply(CorrPri.abs,2,min)
#Elimino las filas y columnas con correlacion baja
CorrPri.max<-CorrPri.abs[-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5)),-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5))]
#Pongo a 0 los valores inferiores a 0.5 y superiores a -0.5
CorrPri.max[which((CorrPri.max<0.5 & CorrPri.max>-0.5),arr.ind = TRUE)]<-0
CorrPri.max<-as.matrix(CorrPri.max)
#Reordenamos por FPC
Orden.fpc<-corrMatOrder(CorrPri.max,order='FPC') #Primer Componente principal
CorrNum.fpc<-CorrPri.max[Orden.fpc,Orden.fpc]
#Grafico
corrplot(CorrNum.fpc,type='lower',tl.col = 'black',tl.cex = .8,tl.srt = 30)
```
***
En el grafico en la fila inferior tenemos SalePrice.
En rojo las variables con correlacion negativa :
AntGarage Antigüedad
En azul las variables predictoras con correlacion positiva:
GarageArea GarageCars
Fireplaces FireplaceQu
X1stFlrSF TotalBsmtSF
TotRmsAbvGrd GrLivArea FullBath
GarageFinish
KitchenQual
BsmtQual
ExterQual
OverallQual
Las variables que pongo juntas tienen una correlacion fuerte (ver primer grafico ) entre ellas y cierta explicacion lógica.
6. ANTIGUEDAD y ANTGARAGE {data-navmenu="2 PREPARACION"}
============
Es evidente que tiene una gran correlacion porque en cierta medida su valor crece de manera proporcionada.
Si una vivienda tiene un garaje, la antigüedad del garaje crece de igual manera que la antigüedad de la vivienda y suelen ser iguales salvo que el garaje se haya construido después.
De todas formas no soy partidario de unirlas de alguna forma porque la variable AntGarage tiene la peculiaridad de aquellas viviendas sin garaje que hay que mantener
Solo voy a normalizar la varable AntGarage, puesto que Antigüedad ya lo estaba
```{r echo=TRUE}
total$AntGarage<-normalize(total$AntGarage)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
7. GARAGECARS Y GARAGEAREA {data-navmenu="2 PREPARACION"}
=========
A pesar de que tienen relación con otras variables la mas importante es entre ellos, y puede parecer lógico puesto que el numero de coches que pueda entrar en un garaje depende directamente del espacio que este tenga
Primero normalizo las variables según función
```{r echo=TRUE}
TotalNum$GarageArea<-normalize(TotalNum$GarageArea)
TotalNum$GarageCars<-normalize(TotalNum$GarageCars)
cor(x=TotalNum$GarageArea,y=TotalNum$GarageCars,method = 'spearman')
```
La relacion es positiva.
Ambas tienen una correlacion positiva y parecida con respecto al precio
```{r collapse=TRUE,echo=TRUE}
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
cor(x=TrainNum$GarageArea,y=TrainNum$SalePrice,method = 'spearman')
cor(x=TrainNum$GarageCars,y=TrainNum$SalePrice,method = 'spearman')
```
La opcion que opto es multiplicar ambas variables puesto que `GarageCars` es discreta y `GarageArea` es continua.
La nueva variable `GARAGETOTAL` se convierte en continua, mantiene la normalización y el valor 0 para los que no tienen garaje
```{r collapse=TRUE, echo=TRUE}
TrainNum$Garage2<-TrainNum$GarageArea*TrainNum$GarageCars
cor(x=TrainNum$Garage2,y=TrainNum$SalePrice,method = 'spearman')
```
Es una correlacion media de las otras dos.
Normalizo y actualizo
```{r echo=TRUE}
total$GarageTotal<-normalize(total$GarageArea)*normalize(total$GarageCars)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
8. FIREPLACES y FIREPLACEQU {data-navmenu="2 PREPARACION"}
===========
Column
--------
`Fireplaces` es el numero de chimeneas
`FireplacesQu` es la calidad según vimos cuando se paso de categorica a ordinal
La correlacion positiva entre ellas nos indica que a medida que el numero de chimeneas aumenta también aumenta la calidad
```{r collapse=TRUE,echo=TRUE}
cor(x=total$Fireplaces,y=total$FireplaceQu,method = 'kendall')
```
Con respecto al precio
```{r echo=TRUE}
cor(x=TrainNum$FireplaceQu,y=TrainNum$SalePrice,method='spearman')
cor(x=TrainNum$Fireplaces,y=TrainNum$SalePrice,method='spearman')
```
La correlacion con el precio no es muy alta y ademas la correlacion entre ellas es altisima, por lo que me quedo con una y descarto la otra
Me quedo con `FireplaceQu`. Y la normalizo
```{r echo=TRUE}
total$FireplaceQu<-normalize(total$FireplaceQu)
```
```{r}
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
Column
----------
Ademas es una relacion fuerte.
Vemos un grafico
```{r collapse=TRUE}
chim<-ggplot(data=TotalNum,aes(x=TotalNum$Fireplaces, y=TotalNum$FireplaceQu))
chim<-chim+geom_count()+labs(x="NUMERO CHIMENEAS",y="CALIDAD CHIMENEAS")
chim
```
9. 1STFlRSF y TOTALBSMTSF {.storyboard data-navmenu="2 PREPARACION"}
============
### La correlacion entre ellos es bastante alta
```{r echo=TRUE}
cor(x=total$X1stFlrSF,y=total$TotalBsmtSF,method='spearman')
```
```{r echo=TRUE}
summary(total$X1stFlrSF)
summary(total$TotalBsmtSF)
```
***
1stFlrSF corresponde al área del primer piso.
TotalBsmtSF es el área del sotano
Se presupone que las viviendas que tienen sotano , por lo general el área en planta del sotano es igual que el de la primera planta.
La diferencia por lo general esta en que todas las viviendas tienen primera planta, pero no todas tienen sotano
### Vemos un grafico esclarecedor
```{r collapse=TRUE}
pru<-ggplot()
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$X1stFlrSF,y=TotalNum$TotalBsmtSF))
pru<-pru+scale_x_continuous(limits=c(0,6150))+scale_y_continuous(limits=c(0,6150))
pru<-pru+labs(x='AREA PRIMER PISO',y='AREA SOTANO')
pru
```
***
Se aprecian dos líneas claramente, una siguiendo el eje de abscisas en o que son las viviendas sin sotano y la otra línea de inclinación 45º que son las viviendas que tienen el mismo área de vivienda que de sotano.
Hay que destacar que hay unas cuantas viviendas que tienen mas área de sotano que de primer piso
### Vemos su correlacion con el precio
```{r echo=TRUE}
cor(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice,method='spearman')
cor(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice,method='spearman')
```
***
No parece que haya una correlacion muy alta .
### Vemos la corelacion con el precio gráficamente
```{r collapse=TRUE}
pru<-ggplot()
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice),color='red')
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice),color='blue')
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
```
### Tenemos dos outliers en la esquina inferior derecha. Les busco y excluyo estos valores para ver si mejora
```{r }
kable(TrainNum%>%filter(X1stFlrSF>3000 & SalePrice<200000)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
```{r echo=TRUE}
TrainNum.piso<-TrainNum%>%filter(Id!=524)%>%filter(Id!=1299)
```
### Vemos de nuevo
```{r collapse=TRUE}
pru<-ggplot()
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='red')
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice),color='blue')
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
```
***
### El grafico parece que ha mejorado. Veamos numéricamente
```{r echo=TRUE}
cor(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice,method='spearman')
cor(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice,method='spearman')
```
```{r echo=TRUE}
#Separo las viviendas por el sotano
TrainNum.sot<-TrainNum%>%filter(TotalBsmtSF==0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)
TrainNum.piso<-TrainNum%>%filter(TotalBsmtSF>0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)
```
***
Sí hay mejoria pero no parece significativa.
En principio no descarto estos registros por si afectan a otras variables
Voy a separar en la variable de área de primera planta a las viviendas que tienen sotano y las que no
### Vemos graficamente
```{r collapse=TRUE}
pru<-ggplot()
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='blue',alpha=0.1)
pru<-pru+geom_point(data=TrainNum.sot,aes(x=TrainNum.sot$X1stFlrSF,y=TrainNum.sot$SalePrice),color='red',alpha=0.3)
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
```
```{r}
TrainNum$AreaPiso<-TrainNum$X1stFlrSF+TrainNum$TotalBsmtSF
```
***
Se aprecia que las vivendas sin sotano (puntos rojos) por lo general están penalizadas en el precio, casi todas están en la parte baja de la nube.
En mi opinión se debería combinar ambas variables pero que penalizen a las viviendas sin sotano, parecido a lo que sucedia a la penalizacion en la antigüedad.
Para eso voy a sumar el área del sotano y el de la primera planta
La mayoría de las viviendas verán casi doblada su superficie, pero las viviendas sin sotano se quedan como están
### Vemos graficamente
```{r collapse=TRUE}
pru<-ggplot()
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$AreaPiso,y=TrainNum$SalePrice),color='blue',alpha=0.2)
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
```
### Numericamente
```{r collapse=TRUE}
cor(x=TrainNum$AreaPiso,y=TrainNum$SalePrice,method='spearman')
```
```{r echo=TRUE}
total$AreaPiso<-normalize(total$X1stFlrSF+total$TotalBsmtSF)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
***
La correlacion mejora
La distribución parece bastante parecida.
Dejamos asi la nueva variable y la normalizamos
10. GRLIVAREA FULLBATH TOTRMSABVGRD {.storyboard data-navmenu="2 PREPARACION"}
================
### Vemos la correlacion entre las tres
```{r collapse=TRUE}
kable(cor(total%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
***
Estas variables corresponde a
GrLivArea pies cuadrados del área habitable sobre el nivel del suelo
FullBath baños completos por encima del suelo
TotRmsAbvGrd Total de habitaciones por encima del suelo (no incluye baños)
Parece evidente una relación lógica entre la primera variable y las otras dos
### Graficamente
```{r collapse=TRUE}
pru<-ggplot()
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$TotRmsAbvGrd,y=TotalNum$GrLivArea),color='blue',alpha=0.1)
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$GrLivArea),color='red',alpha=0.3)
pru<-pru+labs(x='Estancias ',y='Area')+scale_y_continuous(labels = scales::comma)
pru
```
***
En rojo el numero de baños y en azul el total de estancias por encima del nivel del suelo.
Todo en funcion del precio de venta de la casa
### Tenemos dos outliers que con un area habitable superior a 5000 y con 12 y 15 habitaciones solo tiene 2 baños
```{r collapse=TRUE}
TotalNum.sala<-TotalNum
kable(TotalNum%>%filter(FullBath==2 & GrLivArea>5000)%>%select(Id,GrLivArea,FullBath,TotRmsAbvGrd))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=11,position = 'center')
```
```{r collapse=TRUE}
print ("Correlacion sin outliers")
TotalNum.sala<-TotalNum.sala%>%filter(Id!=1299)%>%filter(Id!=2550)
kable(cor(TotalNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=11,position = 'center')
```
```{r collapse=TRUE}
print ("Correlacion con outliers")
kable(cor(total%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=11,position = 'center')
```
***
Les descarto y compruebo como queda la matriz de correlacion
Parece que incluso ha empeorado con respecto al anterior (se muestra mas abajo)
### Pero voy a verlo teniendo en cuenta el precio
```{r collapse=TRUE}
TrainNum.sala<-TotalNum.sala%>%filter(is.na(SalePrice)==FALSE)
#Correlacion con outliers
print ("Correlacion con outliers")
kable(cor(TrainNum%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'lawngreen')
#Correlacion sin outliers
print ("Correlacion sin outliers")
kable(cor(TrainNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'lawngreen')
```
***
Se puede observar como al quitar los outliers la correlacion entre las variables que estudiamos empeoran pero mejoran todas con respecto al precio.
Lo dejamos en recordatorio como los otros outliers que hemos visto para más adelante
### Podemos pensar que si consideramos los baños como una estancia mas podemos unirlo en una sola variable
```{r collapse=TRUE}
#Si se suman los baños y las estancias
#¿No tienen baño?
kable(TotalNum%>%filter(FullBath==0)%>%select(Id,HalfBath,BsmtFullBath,BsmtHalfBath))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
***
**Pregunta**: ¿Qué significa que haya viviendas que no tengan baño?
**Respuesta**: Que tienen medios baños o baños en el sotano
En la tabla las casas que no tienen baño
### Esta es la grafica de la relación entre los baños y el precio
```{r collapse=TRUE,message=FALSE,warnings=FALSE}
pru<-ggplot()
pru<-pru+geom_boxplot(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$SalePrice,group=TotalNum$FullBath),color='red')
pru<-pru+labs(x='Baños ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
```
***
Las vivendas sin baño están penalizadas en el precio aunque no demasiado
### Si sumamos los baños como una `estancia` mas
```{r echo=TRUE}
#Sumamos los baños
TotalNum$estancias<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd
```
```{r}
kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
***
Evidentemente la correlacion con las variables que la componen tiene que ser alta, pero con el area habitable mejora bastante la correlacion individual mejor que tenia antes
La correlacion de `GrLivArea` con `FullBath` es `r cor(x=TotalNum$GrLivArea,y=TotalNum$FullBath,method='spearman')` y con `TotRmsAbvGrd` es `r cor(x=TotalNum$GrLivArea,y=TotalNum$TotRmsAbvGrd,method='spearman')`
Con la nueva variable `estancias` es `r cor(x=TotalNum$GrLivArea,y=TotalNum$estancias,method='spearman')`
### Voy a sumarle también los medios baños pero reducido a la mitad en su valor
```{r echo=TRUE}
#Sumamos los medios baños
TotalNum$estancias2<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd+(TotalNum$HalfBath/2)
```
```{r}
kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,estancias2),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'yellow')%>%row_spec(5,background = 'lawngreen')
```
***
Aunque empeora la correlacion con las otras variables, mejora con el area habitable que es con la que voy a combinarla y normalizarlas
### Combino todo y normalizo
```{r echo=TRUE}
#Combinar con area habitable y normalizar
TotalNum$Habitat<-normalize(TotalNum$estancias2*TotalNum$GrLivArea)
#Comparamos con precio
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
```
```{r}
kable(cor(TrainNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,Habitat,SalePrice),method='spearman'))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(4,background = 'yellow')%>%row_spec(5,background = 'lawngreen')
```
```{r echo=TRUE}
#Crear variable y normalizar
total$Habitat<-normalize((total$FullBath+total$TotRmsAbvGrd+(total$HalfBath/2))*total$GrLivArea)
```
***
Como el numero de estancias es *cuasidiscreto* (por tener medios baños) y el area habitable es continuo multiplico ambos para obtener una nueva variable `Habitat` continua
La nueva variable esta mucho mas correlacionada con las tres variables originales y además se acerca bastante a la variable original de mayor correlacion con el precio
Creamos en dataset conjunto y normalizamos
11. NORMALIZACION DE RESTO DE VARIABLES {data-navmenu="2 PREPARACION"}
=============
GarageFinish acabado interior del garaje
KitchenQual calidad de la cocina
BsmtQual Altura del sótano
ExterQual calidad del material exterior
OverallQual material general y calidad de acabado
Son todas variables ordinales que indican distintos acabados/calidades de la vivienda
Es razonable pensar que junto con otras variables que no aparecen por no estar tan relacionadas, mantengan una correspondencia al nivel general de calidad de la vivienda y este está asociado al precio de manera importante.
En mi opinión no tiene justificación lógica el combinar varias de estas variables puesto que no tienen una relación causal a pesar de que tengan una correlacion importante
Las normalizamos
```{r echo=TRUE}
total$GarageFinish<-normalize(total$GarageFinish)
total$KitchenQual<-normalize(total$KitchenQual)
total$BsmtQual<-normalize(total$BsmtQual)
total$ExterQual<-normalize(total$ExterQual)
total$OverallQual<-normalize(total$OverallQual)
```
12. CONCLUSION {data-navmenu="2 PREPARACION"}
===========
De todas las variables cuantitativas nos quedamos con las siguientes:
Antiguedad AntGaraje GarageTotal FirePlaceQu AreaPiso Habitat GarageFinish KitchenQual BsmtQual ExterQual OverallQual
De un total de 51 variables numéricas del dataset (excluyendo la identificación `Id` y el precio de venta `SalePrice`) hemos reducido las variables predictoras a 11
1. TIPOFACTORES { data-navmenu="3 PREPARACION"}
==========
Column {.tabset}
-----------
### CONDICIONES PREVIAS
El paquete `FactoMineR` tiene varias opciones interesantes para realizar distintas métodos de analisis de datos y entre ellos tiene un método llamado `condes()` que sirve para describir una variable continua en función de variables continuas y/o categóricas
```{r collapse=TRUE}
#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact$Id<-total$Id
TotalFact$SalePrice<-total$SalePrice
TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE)
```
```{R echo=TRUE}
#Buscamos categorias mas proximas a SalePrice
options(digits=12)
fact1<-condes(TrainFact,num.var = 30)
```
Esto nos genera una lista de tres elementos (como maximo)
* Una matriz con las variables cualitativas ordenadas por `R²`
* Una matriz con las variables cuantitativas ordenadas por correlacion
* Una matriz con los coeficientes de cada categoría de las variables cualitativas que cumplen con el `p-value` asignado
Nuestro interés esta en la primera matriz.
Teniendo en cuenta que para la selección de las variables cuantitativas significativas poníamos como criterio que la correlacion debía ser superior a 0.5, entonces en este caso `R²` > (0.5)²=0.25 .
Ese es el limite que ponemos
### VARIABLES
Estas son las variables
```{r echo=TRUE}
#Estas son las variables
fact1.cuali<-as.data.frame(fact1[[1]])
```
```{r}
kable(fact1.cuali)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
### RESUMEN
Si vemos las variables solo hay dos que superan un **`R²`** de 0.25, pero teniendo en cuenta que como en las variables numéricas no había normalidad y para la correlacion use el método de Spearman que suele dar un valor ligeramente superior al de Pearson, en este caso voy a escoger también las dos variables que se han quedado a las puertas con 0.24
En resumen :
`Neighborhood` ubicaciones físicas dentro de los límites de la ciudad de Ames
Tiene 25 categorias
`MSSubClass` la clase de construcción. Tiene 16 categorias
`Foundation` tipo de cimientos. Tiene 6 categorias
`GarageType` ubicación del garaje Tiene 7 categorias
Son un total de 54 categorias.
Si usamos *one hot encoding* suponen `(25-1)+(16-1)+(6-1)+(7-1)=50` nuevas variables a añadir a las 11 numericas que ya tenemos.
Hay que reducirlas
Las revisamos
2. NEIGHBORHOOD (Vecindario){.storyboard data-navmenu="3 PREPARACION"}
===============
### Esta variable tiene 25 categorias. Veamos grafica y ordenadamente por la media
```{r collapse=TRUE}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Barrio',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
### Veamos grafica y ordenadamente por la mediana
```{r collpse=TRUE}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Barrio',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
Voy a intentar reducir las variables.
Para eso voy a utilizar una clasificación jerarquica aglomerativa sencilla mediante `hclust`
Voy a realizar varias clasificaciones y recalcular el coeficiente de determinación que quedaria antes de decidir .
Los clusters que elegimos van de 3 a 8 agrupaciones
Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones)
### Dendograma segun medias
```{r fig.width=14,collapse=TRUE,message=FALSE,warning=FALSE}
#Preparacion
Resultados.vecinos<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos
train.prueba<-TrainFact%>%group_by(Neighborhood)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Neighborhood
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Barrio',cutree(train.hcl,k=4))
train.dat[,4]<-paste0('Barrio',cutree(train.hcl,k=5))
train.dat[,5]<-paste0('Barrio',cutree(train.hcl,k=6))
train.dat[,6]<-paste0('Barrio',cutree(train.hcl,k=7))
train.dat[,7]<-paste0('Barrio',cutree(train.hcl,k=8))
#Se crean nuevas columnas con los clusters calculados
TrainFact$NeighborhoodMean1<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean1)<- train.dat[,2]
TrainFact$NeighborhoodMean2<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean2)<- train.dat[,3]
TrainFact$NeighborhoodMean3<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean3)<- train.dat[,4]
TrainFact$NeighborhoodMean4<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean4)<- train.dat[,5]
TrainFact$NeighborhoodMean5<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean5)<- train.dat[,6]
TrainFact$NeighborhoodMean6<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean6)<- train.dat[,7]
```
### Dendograma segun medianas
```{r fig.width=14,collapse=TRUE,message=FALSE,warning=FALSE}
#Prueba clusterizacion medianas
#Obtencion de los datos
train.prueba3<-TrainFact%>%group_by(Neighborhood)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$Neighborhood
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Barrio', cutree(train.hcl2,k=3))
train.dat2[,3]<-paste0('Barrio', cutree(train.hcl2,k=4))
train.dat2[,4]<-paste0('Barrio',cutree(train.hcl2,k=5))
train.dat2[,5]<-paste0('Barrio',cutree(train.hcl2,k=6))
train.dat2[,6]<-paste0('Barrio',cutree(train.hcl2,k=7))
train.dat2[,7]<-paste0('Barrio', cutree(train.hcl2,k=8))
#Se crean nuevas columnas con los clusters calculados
TrainFact$NeighborhoodMedian1<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian1)<- train.dat2[,2]
TrainFact$NeighborhoodMedian2<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian2)<- train.dat2[,3]
TrainFact$NeighborhoodMedian3<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian3)<- train.dat2[,4]
TrainFact$NeighborhoodMedian4<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian4)<- train.dat2[,5]
TrainFact$NeighborhoodMedian5<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian5)<- train.dat2[,6]
TrainFact$NeighborhoodMedian6<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian6)<- train.dat2[,7]
#Presentacion resultados
Resultados.vecinos<-cbind(c(3,4,5,6,7,8,'Todos'))
Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.vecinos<-as.data.frame(Resultados.vecinos)
colnames(Resultados.vecinos)<-c('Numero clusters','R2 Media','R2 Mediana')
```
3. FOUNDATION (Cimientos){.storyboard data-navmenu="3 PREPARACION"}
==========
### Esta variable tiene 6 categorias. Veamos grafica y ordenadamente por la media
```{r collapse=TRUE}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
### Veamos grafica y ordenadamente por la mediana
```{r collpse=TRUE}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
Realizamos la misma operación que con el vecindario, solo que aquí tenemos 6 grupos por lo que los cluster que elegimos van de 2 a 5
Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones)
### Dendograma segun medias
```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE}
#Preparacion
Resultados.cimientos<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimiento',cutree(train.hcl,k=2))
train.dat[,3]<-paste0('Cimiento',cutree(train.hcl,k=3))
train.dat[,4]<-paste0('Cimiento',cutree(train.hcl,k=4))
train.dat[,5]<-paste0('Cimiento',cutree(train.hcl,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$FoundationMean1<-TrainFact$Foundation
levels(TrainFact$FoundationMean1)<- train.dat[,2]
TrainFact$FoundationMean2<-TrainFact$Foundation
levels(TrainFact$FoundationMean2)<- train.dat[,3]
TrainFact$FoundationMean3<-TrainFact$Foundation
levels(TrainFact$FoundationMean3)<- train.dat[,4]
TrainFact$FoundationMean4<-TrainFact$Foundation
levels(TrainFact$FoundationMean4)<- train.dat[,5]
```
### Dendograma segun medianas
```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE}
#Prueba clusterizacion medianas
#Obtencion de los datos
train.prueba3<-TrainFact%>%group_by(Foundation)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$Foundation
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Cimiento', cutree(train.hcl2,k=2))
train.dat2[,3]<-paste0('Cimiento',cutree(train.hcl2,k=3))
train.dat2[,4]<-paste0('Cimiento',cutree(train.hcl2,k=4))
train.dat2[,5]<-paste0('Cimiento',cutree(train.hcl2,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$FoundationMedian1<-TrainFact$Foundation
levels(TrainFact$FoundationMedian1)<- train.dat2[,2]
TrainFact$FoundationMedian2<-TrainFact$Foundation
levels(TrainFact$FoundationMedian2)<- train.dat2[,3]
TrainFact$FoundationMedian3<-TrainFact$Foundation
levels(TrainFact$FoundationMedian3)<- train.dat2[,4]
TrainFact$FoundationMedian4<-TrainFact$Foundation
levels(TrainFact$FoundationMedian4)<- train.dat2[,5]
#Presentacion resultados
Resultados.cimientos<-cbind(c(2,3,4,5,'Todos'))
Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.cimientos<-as.data.frame(Resultados.cimientos)
colnames(Resultados.cimientos)<-c('Numero clusters','R2 Media','R2 Mediana')
```
4. GARAGETYPE (Ubicacion del garage){.storyboard data-navmenu="3 PREPARACION"}
===========
### Esta variable tiene 7 categorias. Veamos grafica y ordenadamente por la media y la mediana
```{r collapse=TRUE}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
### Veamos grafica y ordenadamente por la mediana
```{r}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
Realizamos la misma operación que con el vecindario, solo que aquí tenemos 7 grupos por lo que los cluster que elegiremos van de 2 a 5
Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones)
### Dendograma segun medias
```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE}
#Preparacion
Resultados.garage<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos
train.prueba<-TrainFact%>%group_by(GarageType)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$GarageType
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('garage',cutree(train.hcl,k=2))
train.dat[,3]<-paste0('garage',cutree(train.hcl,k=3))
train.dat[,4]<-paste0('garage',cutree(train.hcl,k=4))
train.dat[,5]<-paste0('garage',cutree(train.hcl,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$GarageTypeMean1<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean1)<- train.dat[,2]
TrainFact$GarageTypeMean2<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean2)<- train.dat[,3]
TrainFact$GarageTypeMean3<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean3)<- train.dat[,4]
TrainFact$GarageTypeMean4<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean4)<- train.dat[,5]
```
### Dendograma segun medianas
```{r fig.width=12,collapse=TRUE,message=FALSE,warning=FALSE}
#Prueba clusterizacion medianas
#Obtencion de los datos
train.prueba3<-TrainFact%>%group_by(GarageType)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$GarageType
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('garage', cutree(train.hcl2,k=2))
train.dat2[,3]<-paste0('garage',cutree(train.hcl2,k=3))
train.dat2[,4]<-paste0('garage',cutree(train.hcl2,k=4))
train.dat2[,5]<-paste0('garage',cutree(train.hcl2,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$GarageTypeMedian1<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian1)<- train.dat2[,2]
TrainFact$GarageTypeMedian2<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian2)<- train.dat2[,3]
TrainFact$GarageTypeMedian3<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian3)<- train.dat2[,4]
TrainFact$GarageTypeMedian4<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian4)<- train.dat2[,5]
#Presentacion resultados
Resultados.garage<-cbind(c(2,3,4,5,'Todos'))
Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.garage<-as.data.frame(Resultados.garage)
colnames(Resultados.garage)<-c('Numero clusters','R2 Media','R2 Mediana')
```
5. MSSUBCLASS (CLase de construccion){.storyboard data-navmenu="3 PREPARACION"}
===========
### Esta variable tiene 16 categorias. Veamos grafica y ordenadamente por la media
```{r collapse=TRUE}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
### Veamos grafica y ordenadamente por la mediana
```{r}
pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru
```
***
En cada columna aparecen las observaciones
Esta variable es mas peculiar.
Veamosla mas detenidamente
### Vemos sus categorías y apariciones
```{r collapse=TRUE}
kable(table(TrainFact$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(13,background = "yellow")
```
***
Tenemos una categoria con 0 casos en el `Train`
### Buscamos en el dataset `Test`
```{r collapse=TRUE}
TestFact<-TotalFact%>%filter(is.na(SalePrice)==TRUE)
kable(table(TestFact$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(13,background = 'lawngreen')
```
`Id` del nivel buscado
```{r}
TestFact%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id)
```
***
Tiene 1 caso, luego no se puede eliminar directamente de todo el conjunto, pero si debemos **NO** tomarlo en consideracion para la reduccion de variables porque si no trastornaria todos los calculos
### Descarto este `level` para el calculo
```{r collapse=TRUE}
#Descarto este level para el calculo
TrainFact$MSSubClass<-droplevels(TrainFact$MSSubClass,exclude='1-1/2 STORY PUD - ALL AGES')
kable(table(TrainFact$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
***
Podemos ver que ya no figura
Realizamos la misma operación que con el vecindario, solo que aquí tenemos 16 (15 con la que no tratamos transitoriamente) grupos por lo que los cluster que elegiremos van de 3 a 8
Los resultados los presento juntas las cuatro variables en [6. CONCLUSIONES](#conclusiones)
### Dendograma segun medias
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.width=14}
#Preparacion
Resultados.clases<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos
train.prueba<-TrainFact%>%group_by(MSSubClass)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$MSSubClass
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Clase',cutree(train.hcl,k=4))
train.dat[,4]<-paste0('Clase',cutree(train.hcl,k=5))
train.dat[,5]<-paste0('Clase',cutree(train.hcl,k=6))
train.dat[,6]<-paste0('Clase',cutree(train.hcl,k=7))
train.dat[,7]<-paste0('Clase',cutree(train.hcl,k=8))
#Se crean nuevas columnas con los clusters calculados
TrainFact$MSSubClassMean1<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean1)<- train.dat[,2]
TrainFact$MSSubClassMean2<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean2)<- train.dat[,3]
TrainFact$MSSubClassMean3<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean3)<- train.dat[,4]
TrainFact$MSSubClassMean4<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean4)<- train.dat[,5]
TrainFact$MSSubClassMean5<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean5)<- train.dat[,6]
TrainFact$MSSubClassMean6<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean6)<- train.dat[,7]
```
### Dendograma segun medianas
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.width=14}
#Prueba clusterizacion medianas
#Obtencion de los datos
train.prueba3<-TrainFact%>%group_by(MSSubClass)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$MSSubClass
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')
train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Clase', cutree(train.hcl2,k=3))
train.dat2[,3]<-paste0('Clase',cutree(train.hcl2,k=4))
train.dat2[,4]<-paste0('Clase',cutree(train.hcl2,k=5))
train.dat2[,5]<-paste0('Clase',cutree(train.hcl2,k=6))
train.dat2[,6]<-paste0('Clase',cutree(train.hcl2,k=7))
train.dat2[,7]<-paste0('Clase',cutree(train.hcl2,k=8))
#Se crean nuevas columnas con los clusters calculados
TrainFact$MSSubClassMedian1<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian1)<- train.dat2[,2]
TrainFact$MSSubClassMedian2<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian2)<- train.dat2[,3]
TrainFact$MSSubClassMedian3<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian3)<- train.dat2[,4]
TrainFact$MSSubClassMedian4<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian4)<- train.dat2[,5]
TrainFact$MSSubClassMedian5<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian5)<- train.dat2[,6]
TrainFact$MSSubClassMedian6<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian6)<- train.dat2[,7]
#Presentacion resultados
Resultados.clases<-cbind(c(3,4,5,6,7,8,'Todos'))
Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.clases<-as.data.frame(Resultados.clases)
colnames(Resultados.clases)<-c('Numero clusters','R2 Media','R2 Mediana')
```
6. CONCLUSIONES{.storyboard data-navmenu="3 PREPARACION"}
==============
### CRITERIOS
```{r collapse=TRUE}
#Añado la diferencia en columna
options(digits=8)
Resultados.cimientos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.cimientos$`R2 Media`))[Resultados.cimientos$`R2 Media`]-as.numeric(levels(Resultados.cimientos$`R2 Mediana`))[Resultados.cimientos$`R2 Mediana`])
Resultados.clases$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.clases$`R2 Media`))[Resultados.clases$`R2 Media`]-as.numeric(levels(Resultados.clases$`R2 Mediana`))[Resultados.clases$`R2 Mediana`])
Resultados.garage$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.garage$`R2 Media`))[Resultados.garage$`R2 Media`]-as.numeric(levels(Resultados.garage$`R2 Mediana`))[Resultados.garage$`R2 Mediana`])
Resultados.vecinos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.vecinos$`R2 Media`))[Resultados.vecinos$`R2 Media`]-as.numeric(levels(Resultados.vecinos$`R2 Mediana`))[Resultados.vecinos$`R2 Mediana`])
```
He obtenido en las siguientes tablas los coeficientes de determinación de las variables agrupadas en diferentes clusters.
Tambien figura el valor del que partíamos bajo el epigrafe `Todos`
La idea es optimizar el numero que nos quedaremos teniendo en cuenta que ya tenemos 11 variables numéricas
Lo primero mas destacable que se observa es que no hay diferencias tomando la media o la mediana de los precios en la variable `GarageType`.
Esto se explica porque el dendograma es idéntico en ambos supuestos. [Aqui](#garagetype-ubicacion-del-garage) se puede ver
Lo segundo que destaca es que en la gran mayoría de los supuestos tomar como referencia la media del precio suele ser mejor que hacerlo con la mediana. La diferencia es positiva en la mayoría de los casos.
Descartamos trabajar con la mediana
Como criterios:
* En primer lugar seguir el orden asignado por el coeficiente de determinación general. Tendran preferencias las categorías de `Neighborhood`, sobre el resto, luego `Foundation`, `GarageType` y por ultimo `MSSubClass`
* Luego elegir aquel agrupamiento en que el paso a un numero de cluster menor suponga una diferencia muy superior a la que supuso el paso anterior (de un numero de clusters mayor).
Veremos todo en una tabla con una vista mas amigable
### NEIGHBORHOOD (Vecindario)
```{r collapse=TRUE}
kable(Resultados.vecinos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'yellow')%>%row_spec(3,background = 'lawngreen')
```
***
Marco la fila de las casillas de salto mas grandes en amarillo.
Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 4 clusters y elegimos **5**
### FOUNDATION (Cimientos)
```{r}
kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen')
```
***
Descartamos primero aquellas con un coeficiente muy bajo.
Las tacho en naranja. Ese es el minimo
En este caso 2 clusters
Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 4 clusters y elegimos **5**
### GARAGETYPE (Ubicacion del garage)
```{r}
kable(Resultados.garage)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'orange')%>%row_spec(3,background = 'lawngreen')
```
***
Descartamos primero aquellas con un coeficiente muy bajo.
Las tacho en naranja. Ese es el minimo
En este caso 3 clusters
Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 3 clusters. El mismo que techamos en naranja. Elegimos **4**
### MSSubClass (Clase de construccion)
```{r}
kable(Resultados.clases)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen')
```
***
Descartamos primero aquellas con un coeficiente muy bajo.
Las tacho en naranja. Ese es el minimo
En este caso 3 clusters
Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar
En este caso son 5 clusters. Elegimos **6**
### PRIMERA CONCLUSION
Tenemos que la primera elección es :
* Vecinos: 5 clusters sobre 25 categorias Correlacion ~0.7312
* Cimientos 5 clusters sobre 6 categorias Correlacion ~0.5061
* Garaje 4 clusters sobre 7 categorias Correlacion~0.4976
* Clases 6 clusters sobre 16 categorias Correlacion ~0.4937
Son un total de 20 categorias.
En las dos ultimas (Garage y Clases ) parece difícil reducir mas sin que haya una perdida importante, y ya están muy al limite.
Quizas podríamos reducir uno o dos mas en Cimientos, pero la cantidad de 31 variables numéricas , entre las originales y las reconvertidas puede ser una buena cifra
Para realizar la actualización recuperamos parte del código con el numero cluster que hemos decidido en `Neighborhood`, `Foundation` y `GarageType`.
```{r message=FALSE,warning=FALSE}
#Escojo los agrupamientos
#Vecinos 5 clusters
train.prueba<-TrainFact%>%group_by(Neighborhood)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Neighborhood
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=5))
TotalFact$NeighborhoodMean4<-TotalFact$Neighborhood
levels(TotalFact$NeighborhoodMean4)<- train.dat[,2]
total$Vecindario<-TotalFact$NeighborhoodMean4
#Cimientos 5 clusters
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=5))
TotalFact$FoundationMean4<-TotalFact$Foundation
levels(TotalFact$FoundationMean4)<- train.dat[,2]
total$Cimientos<-TotalFact$FoundationMean4
#Garage 4 clusters
train.prueba<-TrainFact%>%group_by(GarageType)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$GarageType
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Garage',cutree(train.hcl,k=4))
TotalFact$GarageTypeMean3<-TotalFact$GarageType
levels(TotalFact$GarageTypeMean3)<- train.dat[,2]
total$UbicaGarage<-TotalFact$GarageTypeMean3
```
### MODIFICACION EN `MSSUBCLASS`.
Para el caso de la variable `MSSubClass` tenemos que recordar que para hacer la agrupación teníamos una categoría que se encontraba en el dataset `Test` pero no en el `Train`, luego dejamos esa categoría apartada , pero ahora hay que introducirla manualmente en un cluster.
Para encontrar en que cluster voy a buscar registros con ciertas variables muy correlacionadas con el objetivo y que se parezcan a las del que buscamos.
Voy a usar las variables numéricas `Habitat`, `AreaPiso` y `OverallQual`
Primero identificaremos el registro del `Test`
```{r collapse=TRUE}
#Clases 6 clusters
#TrainFact$MSSubClassMean4
#Busqueda
kable(total%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id,AreaPiso,Habitat,OverallQual))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')
```
A continuacion escogemos las ventanas de los parametros para el filtrado
0.06<`AreaPiso`<0.12
0.16<`Habitat`<0.18
0.6<`OverallQual`<0.7
### Filtramos por aproximacion a estas variables
```{r echo=TRUE}
prue<-total%>%filter(OverallQual>0.6 & OverallQual<0.7)%>%select(Id,AreaPiso,Habitat,MSSubClass)
prue<-prue%>%filter(AreaPiso>0.06 & AreaPiso<0.12)
prue<-prue%>%filter(Habitat>0.16 & Habitat<0.18)%>%select(Id,MSSubClass)
```
```{r}
kable(table(prue$MSSubClass))%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(6,background = 'lawngreen')
```
```{r message=FALSE,warning=FALSE}
#Modificacion
train.prueba<-TrainFact%>%group_by(MSSubClass)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$MSSubClass
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=6))
TotalFact$MSSubClassMean4<-TotalFact$MSSubClass
```
***
Hay 11 registros con campos parecidos, incluido el que buscamos.
La gran mayoría 9 tienen en `MSSubClass`-> `2-STORY 1946 & NEWER`.
Donde esté esta categoría agrupada pondremos la que nos falta con parte del mismo codigo usado en las variables anteriores
### Modificacion especial
Hasta aquí es todo igual en el codigo que en n las variables anteriores.
Vamos a buscar en que grupo queda `2-STORY 1946 & NEWER` que es donde hay que meter el nivel de factor que nos falta
```{r collapse=TRUE}
#Vemos el que falta y se añade
kable(train.dat)%>%kable_styling(bootstrap_options = c('bordered','condensed','hover'),font_size=12,position = 'center')%>%row_spec(6,background = 'lawngreen')
```
Es el elemento numero 6 que corresponde al cluster `Clase4`
Ademas
```{r echo=TRUE}
levels(total$MSSubClass)
```
`1-1/2 STORY PUD - ALL AGES` tiene que ir en la posicion numero 13.
La añadiremos como una fila a train.dat desplazando el resto
```{r echo=TRUE}
#Añado el level
levels(train.dat$train.dat)<-c(levels(train.dat$train.dat),'1-1/2 STORY PUD - ALL AGES')
#Añado la fila
train.dat<-rbind(train.dat,c('1-1/2 STORY PUD - ALL AGES','Clase4'))
#Cojo levels originales como vector
lev<-as.vector(levels(total$MSSubClass))
#Comparo y ordeno
train.dat<-train.dat[match(lev,train.dat$train.dat),]
#Ya estan ordenados los level y los valores que les sutituyen
levels(TotalFact$MSSubClassMean4)<-train.dat$V2
total$Clases<-TotalFact$MSSubClassMean4
```
1. INTRODUCCION {data-navmenu="MODELIZACION"}
=========
Para buscar el modelo que mas conviene tomar para realizar la prediccion que se pide voy a dividir el conjunto de predictores en varias partes.
Por un lado aquellos predictores que son desde el origen numéricos y que además son continuos o discretos con un numero amplio de intervalos
Son :`Antiguedad`, `AntGarage`, `AreaPiso`, `GarageTotal`, `Habitat` y `OverallQual`
En otro grupo los predictores numéricos de origen ordinal con un numero pequeño de intevalos.
Son : `BsmtQual`, `ExterQual`, `FireplaceQu`, `GarageFinish` y `KitchenQual`
En el ultimo grupo los predictores de origen categoricos
Son : `Neighborhood`, `Foundation`, `GarageType` y `MSSubClass`
Esta división solo la hago en sentido grafico para apreciar mejor las diversas características
Voy a aplicar un modelo lineal multiple, uno polinómico, otro suavizado tipo Loess y uno suavizado con curvas Spline y vamos a comparar en cada variable con respecto a la objetivo SalePrice
Aunque el grafico es muy completo entre toda las variables solos nos interesa la fila inferior donde aparecen los graficos de cada predictor en función del objetivo
Podemos ver también en las primeras graficas en la columna mas a la derecha el valor de correlacion de SalePrice con el resto de variables
2. NUMERICAS Continuas {.storyboard data-navmenu="MODELIZACION"}
============
### Vision de conjunto 1
Modelo Lineal (lm)-Cyan
Suavizado Local(Loess)-Rojo
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
#preparacion datos
Model1<-total%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual,SalePrice)
ModelTrain1<-Model1%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
GGP1<-ggpairs(ModelTrain1, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
GGP1<-GGP1+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1))
GGP1
```
### Vision de conjunto 2
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
GGP2<-ggpairs(ModelTrain1, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja")
GGP2<-GGP2+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1))
GGP2
```
### Vision de conjunto 3
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
GGP3<-ggpairs(ModelTrain1, lower = list(continuous = my_rg3), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Verde y Suavizado Local(Loess)-Rojo")
GGP3<-GGP3+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1))
GGP3
```
### ANTIGUEDAD
```{r collapse=TRUE,message=FALSE,warning=FALSE}
#Plots individuales
p11<-getPlot(GGP1,7,1)
p12<-getPlot(GGP1,7,2)
p13<-getPlot(GGP1,7,3)
p14<-getPlot(GGP1,7,4)
p15<-getPlot(GGP1,7,5)
p16<-getPlot(GGP1,7,6)
p31<-getPlot(GGP3,7,1)
p36<-getPlot(GGP3,7,6)
p11<-p11+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p12<-p12+labs(title="AntGarage")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p13<-p13+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p14<-p14+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p15<-p15+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p16<-p16+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p31<-p31+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p36<-p36+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
```
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p11
```
***
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Se adapta mejor la curva suavizada que la recta
### ANTIGUEDAD GARAGE (AntGarage)
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p12
```
***
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
La especificidad de los datos (como poner antigüedad a los que no tienen garaje) hace que salga una grafica extraña, pero me decanto por el modelo lineal
### AREAPISO
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p13
```
***
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Los outliers hacen que las curvas no sirvan, pero sin ellos podria ser la opcion adecuada
### GARAGETOTAL
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p14
```
***
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion
### HABITAT
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p15
```
***
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Los outliers hacen que las curvas no sirven, pero sin ellos podrian ser la opcion
### OVERALLQUALL . material general y calidad de acabado
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p16
```
***
Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo
Pasa algo parecido que con la antigüedad. Se adapta mejor una curva
### ANTIGUEDAD: COMPARATIVA DE CURVAS
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p31
```
***
Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo
Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente
### OVERALLQUALL: COMPARATIVA DE CURVAS
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p36
```
***
Regresion:
B Splines (bs)-Verde
Suavizado Local(Loess)-Rojo
Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente
3. NUMERICAS discretas {.storyboard data-navmenu="MODELIZACION"}
============
### Vision de conjunto 1
Regresion: Modelo Lineal (lm)-Cyan
Suavizado Local(Loess)-Rojo
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=7,fig.width=15}
#Preparacion de datos
Model2<-total%>%select(Id,BsmtQual,ExterQual,FireplaceQu,GarageFinish,KitchenQual,SalePrice)
ModelTrain2<-Model2%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
GGP4<-ggpairs(ModelTrain2, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
GGP4<-GGP4+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1))
GGP4
```
***
El metodo de regresion local `LOESS` no es aceptable en estas variables
### Vision de conjunto 2
Regresion: B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
GGP5<-ggpairs(ModelTrain2, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja")
GGP5<-GGP5+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1))
GGP5
```
### Vision de conjunto 3
Regresion: Modelo lineal con intervalo de confianza - Purpura
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
GGP6<-ggpairs(ModelTrain2, lower = list(continuous = my_rg4), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo lineal con intervalo de confianza - Purpura")
GGP6<-GGP6+theme(plot.title = element_text(color='darkorange',hjust=.3,size=22,lineheight = 1))
GGP6
```
### BSMTQUAL . Altura del sotano
```{r collapse=TRUE,message=FALSE,warning=FALSE}
#Plots individuales
p51<-getPlot(GGP5,6,1)
p52<-getPlot(GGP5,6,2)
p53<-getPlot(GGP5,6,3)
p54<-getPlot(GGP5,6,4)
p55<-getPlot(GGP5,6,5)
p51<-p51+labs(title="BsmtQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p52<-p52+labs(title="ExterQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p53<-p53+labs(title="FireplaceQu")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p54<-p54+labs(title="GarageFinish")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p55<-p55+labs(title="KitchenQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
```
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p51
```
***
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
Se adapta mejor la curva suavizada que la recta
### EXTERQUAL . Calidad del material exterior
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p52
```
***
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
Se adapta mejor la curva suavizada que la recta
### FIREPLACEQU . Calidad de la chimenea
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p53
```
***
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
No esta tan claro que tipo se adapta mejor. Se vera numericamente
### GARAGEFINISH . Acabado interior del garage
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p54
```
***
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
No esta tan claro que tipo se adapta mejor. Se vera numericamente
### KITCHENQUAL . Calidad de la cocina
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p55
```
***
Regresion:
B Splines (bs)-Purpura
Modelo lineal polinomico (poly)-Naranja
Se adapta mejor la curva suavizada que la recta
4. CATEGORICAS {.storyboard data-navmenu="MODELIZACION"}
============
### Vision de conjunto 1
Boxplots
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=7,fig.width=15}
#preparacion
Model3<-total%>%select(Id,Neighborhood,Foundation,GarageType,MSSubClass,SalePrice)
ModelTrain3<-Model3%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
ModelTrain3$Neighborhood<-reorder(ModelTrain3$Neighborhood,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$Foundation<-reorder(ModelTrain3$Foundation,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$GarageType<-reorder(ModelTrain3$GarageType,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$MSSubClass<-reorder(ModelTrain3$MSSubClass,ModelTrain3$SalePrice,FUN = 'mean')
GGP7<-ggpairs(ModelTrain3, lower = list(combo = 'box'), diag = list(continuous = "densityDiag"), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas')
GGP7<-GGP7+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP7
```
***
En cuanto a las variables categoricas , no se puede hacer ningún análisis grafico de lineas de regresion por la propia composición de la variable.
Si podemos ver una matriz de graficos de sus variables origen ordenadas por la variable destino
### Vision de conjunto 2
Nubes de puntos
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
GGP8<-ggpairs(ModelTrain3, lower = list(combo = 'dot'), diag = list(continuous = "densityDiag",discrete='barDiag'), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas')
GGP8<-GGP8+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP8
```
### Neighborhood . Vecindario
```{r collapse=TRUE,message=FALSE,warning=FALSE}
#Plots individuales
p81<-getPlot(GGP8,5,1)
p82<-getPlot(GGP8,5,2)
p83<-getPlot(GGP8,5,3)
p84<-getPlot(GGP8,5,4)
p81<-p81+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p82<-p82+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p83<-p83+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p84<-p84+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
```
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p81
```
***
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
### Foundation . Cimientos
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p82
```
***
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
### GarageType . Ubicacion del garage
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p83
```
***
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
### MSSubClass . Clase de construccion
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p84
```
***
Ordenadas las categorias por la media respecto a la variable objetivo y colocadas parece existir cierta linealidad
### Vemos ahora con la agrupación de clusters y ordenadas
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
#DUMMYS
#preparacion
Model4<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases,SalePrice)
ModelTrain4<-Model4%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
ModelTrain4$Vecindario<-reorder(ModelTrain4$Vecindario,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$Cimientos<-reorder(ModelTrain4$Cimientos,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$UbicaGarage<-reorder(ModelTrain4$UbicaGarage,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$Clases<-reorder(ModelTrain4$Clases,ModelTrain4$SalePrice,FUN = 'mean')
GGP9<-ggpairs(ModelTrain4, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none")
GGP9<-GGP9+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1))
GGP9
```
```{r collapse=TRUE,message=FALSE,warning=FALSE}
#Plots individuales
p91<-getPlot(GGP9,5,1)
p92<-getPlot(GGP9,5,2)
p93<-getPlot(GGP9,5,3)
p94<-getPlot(GGP9,5,4)
p91<-p91+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p92<-p92+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p93<-p93+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p94<-p94+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
```
### Neighborhood . Vecindario
5 clusters
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p91
```
***
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
### Foundation . Cimientos
**5 clusters**
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p92
```
***
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Es posible eliminar un cluster mas en `Cimientos` como se había apuntado, pero ahora se ve mejor
### GarageType . Ubicacion del garage
**4 clusters**
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p93
```
***
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
### MSSubClass . Clase de construccion
**6 clusters**
```{r echo=FALSE,fig.height=3,fig.width=10,out.width='75%'}
p94
```
***
Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
### Foundation
Resultados para 3, 4 y 5 clusters
```{r collapse=TRUE,message=FALSE,warning=FALSE}
#Revision de cimientos . Reduccion de 5 clusters
#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact$Id<-total$Id
TotalFact$SalePrice<-total$SalePrice
TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE)
#Cimientos 3 y 4 clusters
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Cimientos',cutree(train.hcl,k=4))
TotalFact$FoundationMean3<-TotalFact$Foundation
TotalFact$FoundationMean4<-TotalFact$Foundation
levels(TotalFact$FoundationMean3)<- train.dat[,2]
levels(TotalFact$FoundationMean4)<- train.dat[,3]
#Carga provisional en dataset
total$Cimientos1<-TotalFact$FoundationMean3
total$Cimientos2<-TotalFact$FoundationMean4
```
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
#Recarga de informacion
Model5<-total%>%select(Id,Cimientos1,Cimientos2,Cimientos,SalePrice)
ModelTrain5<-Model5%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
ModelTrain5$Cimientos1<-reorder(ModelTrain5$Cimientos1,ModelTrain5$SalePrice,FUN = 'mean')
ModelTrain5$Cimientos2<-reorder(ModelTrain5$Cimientos2,ModelTrain5$SalePrice,FUN = 'mean')
ModelTrain5$Cimientos<-reorder(ModelTrain5$Cimientos,ModelTrain5$SalePrice,FUN = 'mean')
GGP10<-ggpairs(ModelTrain5, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none",title='Resultados para cluster de Cimientos: 3 , 4 o 5')
GGP10<-GGP10+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1))
GGP10
```
### Foundation . Cimientos
**5 clusters**
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p101<-getPlot(GGP10,4,1)
p102<-getPlot(GGP10,4,2)
p103<-getPlot(GGP10,4,3)
p101<-p101+labs(title="Cluster n=3")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p102<-p102+labs(title="Cluster n=4")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p103<-p103+labs(title="Cluster n=5")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p103
```
### Foundation . Cimientos
**4 clusters**
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p102
```
### Foundation . Cimientos
**3 clusters**
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p101
```
### Conclusion
```{r collapse=TRUE}
kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(2,background = 'lawngreen')
#Se escoge 3 cluster
total$Cimientos<-total$Cimientos1
total$Cimientos1<-NULL
total$Cimientos2<-NULL
```
***
Graficamente la mejor opcion es n=3.
Ademas vimos en la sección anterior que no había tanta diferencia
### Transformación de las categorías de las variables no numéricas en variables `dummy`
```{r echo=TRUE }
#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact1<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact1$Id<-total$Id
#Conversion a Dummys
Total.dummy.B<-TotalFact1%>%select(Id,B=Vecindario)
Total.dummy.C<-TotalFact1%>%select(Id,C=Cimientos)
Total.dummy.G<-TotalFact1%>%select(Id,G=UbicaGarage)
Total.dummy.N<-TotalFact1%>%select(Id,N=Clases)
modelo1.B<-as.data.frame(model.matrix(~.,Total.dummy.B))
modelo1.C<-as.data.frame(model.matrix(~.,Total.dummy.C))
modelo1.G<-as.data.frame(model.matrix(~.,Total.dummy.G))
modelo1.N<-as.data.frame(model.matrix(~.,Total.dummy.N))
modelo1.B$`(Intercept)`<-NULL
modelo1.C$`(Intercept)`<-NULL
modelo1.G$`(Intercept)`<-NULL
modelo1.N$`(Intercept)`<-NULL
modelo1<-modelo1.B
modelo1<-cbind(modelo1,modelo1.C%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.G%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.N%>%select(-Id))
#Modelo con dummys
Cuant<-total%>%select(Antiguedad,AntGarage,AreaPiso,BsmtQual,ExterQual,FireplaceQu,GarageFinish,GarageTotal,Habitat,KitchenQual,OverallQual,SalePrice)
modelo1.dummy<-cbind(modelo1,Cuant)
#Modelo con variables categoricas
Total.dummy<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases)
modelo1.Nodummy<-cbind(Total.dummy,Cuant)
```
5. OUTLIERS { .storyboard data-navmenu="MODELIZACION"}
===========
### VALORES YA REVISADOS
Si recordamos encontramos dos valores outliers .
El registro 524 que tenia discordancia entre los años de construcción, remodelación y venta (corregido) y además tenia un precio muy bajo para el área habitable en sotano y primer piso.
Eso mismo le pasaba al registro 1299 que tenia un precio muy bajo para el área habitable y además no tenia proporción entre el área habitable, las habitaciones y los baños
En principio tenia pensado dejarles por que además en común con estos dos teniamos el registro 2550 que tenia discordancia en los años y falta de proporción entre el área habitable, las habitaciones y los baños, y este registro esta en el `Test`, pero he creido mas conveniente eliminarles de los datos
Antes de eliminarlos vamos a comprobar que posición ocupan en las variables numéricas normalizadas porque si son el valor extremo, máximo o minimo , al eliminarlo deberemos volver a normalizar esa variable con el nuevo extremo
### COMPROBACION Y NORMALIZACION
```{r collapse=TRUE}
#Vemos valores de variables numericas de los outliers por si hay que volver a normalizar
kable(modelo1.Nodummy%>%slice(524)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
kable(modelo1.Nodummy%>%slice(1299)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
```
```{r echo=TRUE}
#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=524)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1299)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=524)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1299)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)
modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)
```
***
Tanto `Antigüedad` como `AntGarage` ,y `OverallQuall` tienen varios registros con el mismo valor que el que vamos a eliminar, .
Sin embargo en `AreaPiso` el registro 1299 es el máximo. Cuando le eliminemos hay que normalizar de nuevo
Realizaremos una comprobacion grafica de las variables mas afectadas por los outliers que vimos en la seccion anterior
Afectaban sobre todo a `AreaPiso`, `GarageTotal` y `Habitat`.
### `AreaPiso` antes
```{r collapse=TRUE, echo=FALSE}
GGP11<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
p131<-getPlot(GGP11,4,1)
p141<-getPlot(GGP11,4,2)
p151<-getPlot(GGP11,4,3)
p131<-p131+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p141<-p141+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p151<-p151+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
```
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p13
```
***
Con los outliers que distorsionaban la curva
### `AreaPiso` despues
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p131
```
***
Han mejorado
### `GarageTotal` antes
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p14
```
***
Con los outliers que distorsionaban la curva
### `GarageTotal` despues
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p141
```
***
Tenemos otros outliers que aparecen en `GarageTotal`
### `Habitat` antes
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p15
```
***
Con los outliers que distorsionaban la curva
### `Habitat` despues
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p151
```
***
Han mejorado
### Seleccionamos los *outliers* que aparecian en `GarageTotal` y vemos su influencia en `AreaPiso` (puntos en rojo)
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p132<-p131+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$AreaPiso,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none')
p152<-p151+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$Habitat,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none')
p132
```
***
No tienen una gran influencia, ni su mantenimiento, ni su eliminacion
### Seleccionamos los *outliers* que aparecian en `GarageTotal` y vemos su influencia en `Habitat` (puntos en rojo)
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p152
```
***
No tienen una gran influencia, ni su mantenimiento, ni su eliminacion
### Los eliminamos, actualizamos, normalizamos y volvemos a revisar los graficos
````{r}
kable(total%>%filter(GarageTotal>0.5 & SalePrice<300000)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"),font_size = 10 )
```
```{r echo =TRUE}
#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=582)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1062)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1191)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1351)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=582)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1062)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1191)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1351)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)
modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)
```
***
Volvemos a cargar los graficos y comparamos
### `AreaPiso` antes segundos outliers
```{r collapse=TRUE, echo=FALSE}
GGP12<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
p132<-getPlot(GGP12,4,1)
p142<-getPlot(GGP12,4,2)
p152<-getPlot(GGP12,4,3)
p132<-p132+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p142<-p142+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p152<-p152+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
```
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p131
```
### `AreaPiso` despues segundos outliers
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p132
```
### `GarageTotal` antes segundos outliers
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p141
```
***
Con los outliers que distorsionaban la curva
### `GarageTotal` despues segundos outliers
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p142
```
***
Vemos como ha mejorado bastante
### `Habitat` antes segundos outliers
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p151
```
### `Habitat` despues segundos outliers
```{r echo=FALSE,collapse=TRUE,fig.height=3,fig.width=10,out.width='75%'}
p152
```
1. FILTRADO {data-navmenu="SELECCION Y PREDICCION"}
===========
Vamos a realizar un filtrado de las variables mediante el método `sbf()` del paquete `caret`
Vamos a realizarlo con dos funciones internas diferentes para poder comparar y validar los resultados , `ramdom forest` y `modelo lineal`
```{r echo=TRUE}
#FILTRADO DE VARIABLES CON CARET
#Filtrado con sbf de caret usando RandomForest y Linear Model
# Se crea una semilla para cada partición y cada repetición: el vector debe
# tener B+1 semillas donde B = particiones * repeticiones.
ModeloTrain.Nodummy<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
set.seed(456)
particiones = 10
repeticiones = 5
seeds <- sample.int(1000, particiones * repeticiones + 1)
# Control del filtrado Random Forest
ctrl_filtrado.rf <- sbfControl(functions = rfSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)
# Control del filtrado Linear Model
ctrl_filtrado.lm <- sbfControl(functions = lmSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)
set.seed(234)
rf_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.rf,ntree = 500)
lm_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.lm)
```
Podemos apreciar que los resultados son iguales
De las 25 variables solo se ha descartado 1 `Clase5`. Las que quedan aparecen en las tablas inferiores para los distintos modelos
Aplicamos los resultado y eliminamos variable no influyente
```{r collapse=TRUE}
#Vemos las variables que tenemos que quedarnos
rf_sbf$optVariables%>%kable("html", align = 'clc', caption = 'RANDOM FOREST')%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"), position = "float_left") #optimas variables segun Random Forest
lm_sbf$optVariables%>%kable("html", align = 'clc', caption = 'MODELO LINEAL') %>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"), position = "float_right") #optimas variables segun Linear Model
```
```{r}
Modelo2.Filtrado<-modelo1.dummy%>%select(-NClase5)
Modelo2Train.Filt<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==FALSE)
```
2. MODELADO {data-navmenu="SELECCION Y PREDICCION"}
===========
Antes de empezar a aplicar modelos tenemos que eliminar la variable `Id` de ambos dataset, pero guardando una copia para poder enviar la respuesta
```{r}
#Copia seguridad y eliminacion ID
CopiaTrain<-Modelo2Train.Filt
CopiaTest<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==TRUE)
TrainFinal<-CopiaTrain%>%select(-Id)
TestFinal<-CopiaTest%>%select(-Id,-SalePrice)
```
Para la fijación de nuestro modelo vamos a elegir el método de la validación cruzada del dataset `Train` con 20 iteraciones
No sabiendo que modelo elegir, para lo cual probaremos con el método `train()` del paquete `caret` diversos modelos y veremos que resultados nos aportan
Una cosa interesante que aporta este metodo es que llama a los diversos metodos de distintos paquetes con diferentes hiperparametros y se encarga de seleccionar los parametros propios de cada metodo mas eficientes
```{r results='hide',message=FALSE,warning=FALSE,echo=TRUE}
#PRUEBAS MODELOS
set.seed(234)
#MultiVariate Adaptative Regression Splines
MARS<-train(TrainFinal[,-25],TrainFinal[,25],'gcvEarth',trControl = trainControl(method = 'cv',number = 20))
#Modelo lineal
LM<-train(TrainFinal[,-25],TrainFinal[,25],'lm',trControl = trainControl(method = 'cv',number = 20))
#Ramdom Forest
RF<-train(TrainFinal[,-25],TrainFinal[,25],'ranger',trControl = trainControl(method = 'cv',number = 20))
#Modelo lineal
rlm<-lm(formula = SalePrice~.,data=TrainFinal)
#Regression splines
rnd<-lm(formula=SalePrice~bs(Antiguedad)+bs(OverallQual)+bs(BsmtQual)+bs(ExterQual)+bs(FireplaceQu)+bs(GarageFinish)+bs(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)
#Natural splines
rnd2<-lm(formula=SalePrice~ns(Antiguedad)+ns(OverallQual)+ns(BsmtQual)+ns(ExterQual)+ns(FireplaceQu)+ns(GarageFinish)+ns(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)
#Generalized Additice Model using SPLINE
GAMS<-train(TrainFinal[,-25],TrainFinal[,25],'gamSpline',trControl = trainControl(method = 'cv',number = 20))
#Generalize Linear Models
GLM<-train(TrainFinal[,-25],TrainFinal[,25],'glm',trControl = trainControl(method = 'cv',number = 20))
#Bayesian Ridge Regression
BRR<-train(TrainFinal[,-25],TrainFinal[,25],'bridge',trControl = trainControl(method = 'cv',number = 20))
#Bayesian Ridge Regression (Model Averaged)
BLASSO<-train(TrainFinal[,-25],TrainFinal[,25],'blassoAveraged',trControl = trainControl(method = 'cv',number = 20))
#Extreme gradient boosting
XGB<-train(TrainFinal[,-25],TrainFinal[,25],'xgbLinear',trControl = trainControl(method = 'cv',number = 20))
XGBT<-train(TrainFinal[,-25],TrainFinal[,25],'xgbTree',trControl = trainControl(method = 'cv',number = 20))
```
3. RESULTADOS {.storyboard data-navmenu="SELECCION Y PREDICCION"}
===========
### Vamos a comparar los modelos elegidos
```{r echo=TRUE}
#Comprobacion resultados
options(digits=6)
model<-list(gcvEarth=MARS,lm=LM,ranger=RF,gamSpline=GAMS,glm=GLM,bridge=BRR,blassoAveraged=BLASSO,xgbLinear=XGB,xgbTree=XGBT)
result.resamples<-resamples(model)
#Resutados
metricas_resamples <- result.resamples$values%>%gather(key = "modelo", value = "valor", -Resample)%>%separate(col = "modelo", into = c("modelo", "metrica"), sep = "~", remove = TRUE)
```
```{r}
#Tabla resultados
kable(metricas_resamples %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared)))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))
```
***
* `MAE`: Mean Absolute Error. Media de errores absolutos
* `RMSE`: Root Mean Squared Error. Raiz cuadradra de la media de los residuos al cuadrado.
* `RSquared`: Bondad del ajuste. Es la relacion entre la suma de los cuadrados de regresion y la suma total de cuadrados.
Aunque el uso de un tipo de indicador u otro favorece ciertas caracteristicas en cada modelo, parece claro que hay dos que estan por encima de los demas en todos los indicadores
### Resultados de los modelos con los distintos criterios. (La escala X esta recortada para mejor visualizacion) .
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=15}
graf2<-bwplot(result.resamples,scales=list(relation="free"),xlim=list(c(13000,30000),c(18000,50000),c(0.7,1)))
graf2
```
### Modelos ordenados por `Rsquared`.
```{r collapse=TRUE,message=FALSE,warning=FALSE,fig.height=5,fig.width=10}
#Grafico
graf1<-metricas_resamples %>% filter(metrica == "Rsquared") %>% group_by(modelo) %>% summarise(media = mean(valor)) %>% ggplot(aes(x = reorder(modelo, media), y = media, label = sprintf("%0.4f",round(media, 4))))
graf1<-graf1+ geom_segment(aes(x = reorder(modelo, media), y = 0, xend = modelo, yend = media), color = "grey50")
graf1<-graf1+ geom_point(size = 14, color = "firebrick") + geom_text(color = "white", size = 3.5) + scale_y_continuous(limits = c(0.75, 1))
graf1<-graf1 + labs(title = "Rsquare con CV", subtitle = "Modelos ordenados por media", x = "modelo")
graf1<-graf1+ coord_flip() + theme_bw()
graf1
```
***
Los modelos que parecen mas efectivos son `RandomForest`, y `xgbTree`
* `ranger`: RandomForest es un ensamble en paralelo (bagging) de arboles de predicción en los que se selecciona aleatoriamente los predictores en cada nodo
* `xgbTree`: eXtreme Gradient Boosting es un ensamble secuencial (boosting) de arboles de predicción en el que cada árbol intenta minimizar los residuos del anterior
Los otros modelos que también dan buenos resultados son:
* `GAMSpline` :Generalized Additive Model using Splines es una combinacion lineal de funciones no lineales.Se trata de combinar distintos tipos de regresión en un conjunto no lineal, usando aquí smooth Splines
* `gvcEarth`: MultiVariate Adaptative Regression Splines es parecido al anterior pero usando regression splines
* `XGBLinear` es un un ensamble secuencial como XGBoost pero orientado hacia el modelo lineal
4. PREDICCION {data-navmenu="SELECCION Y PREDICCION"}
===========
En un data frame elijo en varias columnas las predicciones que me da cada modelo
```{r echo =TRUE}
#Calculos previos para ponderaciones
RS<-metricas_resamples%>%filter(metrica=="Rsquared") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared))
RSM<-metricas_resamples%>%filter(metrica=="MAE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(MAE))
RSE<-metricas_resamples%>%filter(metrica=="RMSE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(RMSE))
RST<-RS%>%spread(modelo,Rsquared)
RSMT<-RSM%>%spread(modelo,MAE)
RSET<-RSE%>%spread(modelo,RMSE)
#Calculo para distintas ponderaciones
SumaRs<-RST$ranger+RST$gamSpline+RST$xgbTree+RST$gcvEarth+RST$xgbLinear
SumaRSM<-((1/RSMT$ranger)+(1/RSMT$gamSpline)+(1/RSMT$xgbTree)+(1/RSMT$gcvEarth)+(1/RSMT$xgbLinear))
SumaRSE<-((1/RSET$ranger)+(1/RSET$gamSpline)+(1/RSET$xgbTree)+(1/RSET$gcvEarth)+(1/RSET$xgbLinear))
```
```{r echo=TRUE}
#Prediccion
result<-CopiaTest%>%select(-SalePrice)
result$RF<-predict(RF,TestFinal)
result$GAM<-predict(GAMS,TestFinal)
result$XGBT<-predict(XGBT,TestFinal)
result$MARS <-predict(MARS,TestFinal)
result$XGB <-predict(XGB,TestFinal)
result$media<-round(((result$RF+result$GAM+result$XGBT+result$MARS+result$XGB)/5),digits = 1)
#ponderada sobre Rsquared
result$ponderada<-round((((result$RF*RST$ranger)+(result$GAM*RST$gamSpline)+(result$XGBT*RST$xgbTree)+(result$MARS*RST$gcvEarth)+(result$XGB*RST$xgbLinear))/SumaRs),digits = 1)
#Ponderada sobre MAE
result$ponderada1<-round((((result$RF/RSMT$ranger)+(result$GAM/RSMT$gamSpline)+(result$XGBT/RSMT$xgbTree)+(result$MARS/RSMT$gcvEarth)+(result$XGB/RSMT$xgbLinear))/SumaRSM),digits = 1)
#Ponderada sobre RMSE
result$ponderada2<-round((((result$RF/RSET$ranger)+(result$GAM/RSET$gamSpline)+(result$XGBT/RSET$xgbTree)+(result$MARS/RSET$gcvEarth)+(result$XGB/RSET$xgbLinear))/SumaRSE),digits = 1)
#Redondeo hacia arriba en centenas de los valores
result$RF<-100*ceiling((result$RF/100))
result$GAM<-100*ceiling((result$GAM/100))
result$XGBT<-100*ceiling((result$XGBT/100))
result$MARS<-100*ceiling((result$MARS/100))
result$XGB<-100*ceiling((result$XGB/100))
result$media<-100*ceiling((result$media/100))
result$ponderada<-100*ceiling((result$ponderada/100))
result$ponderada1<-100*ceiling((result$ponderada1/100))
result$ponderada2<-100*ceiling((result$ponderada2/100))
```
```{r echo=TRUE,eval=FALSE}
Fin<-result%>%select(Id,SalePrice=media)
Fin1<-result%>%select(Id,SalePrice=RF)
Fin2<-result%>%select(Id,SalePrice=GAM)
Fin3<-result%>%select(Id,SalePrice=XGBT)
Fin4<-result%>%select(Id,SalePrice=MARS)
Fin5<-result%>%select(Id,SalePrice=XGB)
Fin6<-result%>%select(Id,SalePrice=ponderada)
Fin7<-result%>%select(Id,SalePrice=ponderada1)
Fin8<-result%>%select(Id,SalePrice=ponderada2)
write.csv(Fin,file="Ames2_house.csv",row.names = FALSE)
write.csv(Fin1,file="Ames2_house1.csv",row.names = FALSE)
write.csv(Fin2,file="Ames2_house2.csv",row.names = FALSE)
write.csv(Fin3,file="Ames2_house3.csv",row.names = FALSE)
write.csv(Fin4,file="Ames2_house4.csv",row.names = FALSE)
write.csv(Fin5,file="Ames2_house5.csv",row.names = FALSE)
write.csv(Fin6,file="Ames2_house6.csv",row.names = FALSE)
write.csv(Fin7,file="Ames2_house7.csv",row.names = FALSE)
write.csv(Fin8,file="Ames2_house8.csv",row.names = FALSE)
```
5. TEST {data-navmenu="SELECCION Y PREDICCION"}
===========
Estos son los resultado en `KAGGLE`
El valor corresponde al resultado aplicado al `TEST` que nos da `RMSLE`: *Root Mean Squared Logarithmic Error* similar al `RMSE` pero aplicando una reduccion logaritmica previa a los datos
Column {data-width=700}
-----------
Podemos apreciar que los valores son muy parecidos tanto en la media directa de los modelos escogidos como en aquella ponderacion con el criterio que sea
### **Medias y Ponderadas**
```{r fig.height=3}
include_graphics('Kaggle1.bmp')
```
Column {data-width=700}
-----------
Aunque se mantiene el orden de eficiencia que habiamos obtenido de los modelos durante el entrenamiento , hay que destacar que cualquier mezcla de varios sea con el criterio que sea de ponderacion es mejor que el mejor de los modelos en solitario
### **Modelos**
```{r fig.height=3}
include_graphics('Kaggle2.bmp')
```